diff options
author | Lars Thorsen <[email protected]> | 2015-05-20 10:12:46 +0200 |
---|---|---|
committer | Lars Thorsen <[email protected]> | 2015-05-20 10:12:46 +0200 |
commit | 7b81ed532898c735ad8901723df373e5f0246127 (patch) | |
tree | 5f69565b5016fb08d3bd62ecaf53fa12d4cb7c51 | |
parent | fd63f2b7108e2607e43d709e6d3885e4a7406ec8 (diff) | |
parent | 5bd9afcd35d1a5c46dce8e75c650841a3061f45b (diff) | |
download | otp-7b81ed532898c735ad8901723df373e5f0246127.tar.gz otp-7b81ed532898c735ad8901723df373e5f0246127.tar.bz2 otp-7b81ed532898c735ad8901723df373e5f0246127.zip |
Merge branch 'master' of git-server:otp
Conflicts:
lib/orber/src/orber.app.src
315 files changed, 15020 insertions, 7480 deletions
diff --git a/OTP_VERSION b/OTP_VERSION index 9d7cce5373..a18c6b9fb5 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.0-rc1 +18.0-rc2 diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 861f612657..c4244d91e4 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 861f612657..c4244d91e4 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 77752c3b50..e648a70b2f 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 3c80da02b5..8a9c1d649d 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"5.0.3", +{"5.0.4", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex bedd64eea0..9a644b6b48 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex a3682d4f32..46e3a567b5 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 0c5b6c73e1..bd625968a2 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 3ff5aa73f0..4cdfb47c24 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"3.1", +{"3.2", %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 59d18f9a86..e4b462f5ff 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam Binary files differindex cf763f51a0..71da2376ba 100644 --- a/bootstrap/lib/stdlib/ebin/gb_sets.beam +++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam Binary files differindex 6660dcb787..db59d5af19 100644 --- a/bootstrap/lib/stdlib/ebin/gb_trees.beam +++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 5209c7cfd8..d1aa8bb9dd 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 38a30aed66..52b13fb974 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differnew file mode 100644 index 0000000000..b6e0d20bd7 --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 5bd4c59db4..50eb39d712 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -84,6 +84,7 @@ qlc, qlc_pt, queue, + rand, random, re, sets, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 37251e8e2d..2457f9b4ed 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,11 +15,11 @@ %% under the License. %% %% %CopyrightEnd% -{"2.3", +{"2.4", %% Up from - max one major revision back - [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back - [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 73fa5d3603..352a0ce43c 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -60,7 +60,6 @@ AC_ARG_VAR(erl_xcomp_isysroot, [Absolute cross system root include path (only us dnl Cross compilation variables AC_ARG_VAR(erl_xcomp_bigendian, [big endian system: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_double_middle_endian, [double-middle-endian system: yes|no (only used when cross compiling)]) -AC_ARG_VAR(erl_xcomp_linux_clock_gettime_correction, [clock_gettime() can be used for time correction: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_linux_nptl, [have Native POSIX Thread Library: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_linux_usable_sigusrx, [SIGUSR1 and SIGUSR2 can be used: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_linux_usable_sigaltstack, [have working sigaltstack(): yes|no (only used when cross compiling)]) @@ -726,9 +725,48 @@ esac AC_DEFUN(ERL_MONOTONIC_CLOCK, [ - AC_CACHE_CHECK([for clock_gettime() with monotonic clock type], erl_cv_clock_gettime_monotonic, + default_resolution_clock_gettime_monotonic="CLOCK_HIGHRES CLOCK_BOOTTIME CLOCK_MONOTONIC" + low_resolution_clock_gettime_monotonic="CLOCK_MONOTONIC_COARSE CLOCK_MONOTONIC_FAST" + high_resolution_clock_gettime_monotonic="CLOCK_MONOTONIC_PRECISE" + + case "$1" in + high_resolution) + check_msg="high resolution " + prefer_resolution_clock_gettime_monotonic="$high_resolution_clock_gettime_monotonic" + ;; + low_resolution) + check_msg="low resolution " + prefer_resolution_clock_gettime_monotonic="$low_resolution_clock_gettime_monotonic" + ;; + custom_resolution) + check_msg="custom resolution " + prefer_resolution_clock_gettime_monotonic="$2" + ;; + *) + check_msg="" + prefer_resolution_clock_gettime_monotonic= + ;; + esac + + AC_CACHE_CHECK([for clock_gettime(CLOCK_MONOTONIC_RAW, _)], erl_cv_clock_gettime_monotonic_raw, [ - for clock_type in CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_MONOTONIC_PRECISE; do + AC_TRY_COMPILE([ +#include <time.h> + ], + [ + struct timespec ts; + long long result; + clock_gettime(CLOCK_MONOTONIC_RAW, &ts); + result = ((long long) ts.tv_sec) * 1000000000LL + + ((long long) ts.tv_nsec); + ], + erl_cv_clock_gettime_monotonic_raw=yes, + erl_cv_clock_gettime_monotonic_raw=no) + ]) + + AC_CACHE_CHECK([for clock_gettime() with ${check_msg}monotonic clock type], erl_cv_clock_gettime_monotonic_$1, + [ + for clock_type in $prefer_resolution_clock_gettime_monotonic $default_resolution_clock_gettime_monotonic $high_resolution_clock_gettime_monotonic $low_resolution_clock_gettime_monotonic; do AC_TRY_COMPILE([ #include <time.h> ], @@ -739,12 +777,12 @@ AC_DEFUN(ERL_MONOTONIC_CLOCK, result = ((long long) ts.tv_sec) * 1000000000LL + ((long long) ts.tv_nsec); ], - erl_cv_clock_gettime_monotonic=$clock_type, - erl_cv_clock_gettime_monotonic=no) - test $erl_cv_clock_gettime_monotonic = no || break + erl_cv_clock_gettime_monotonic_$1=$clock_type, + erl_cv_clock_gettime_monotonic_$1=no) + test $erl_cv_clock_gettime_monotonic_$1 = no || break done ]) - + AC_CHECK_FUNCS([clock_getres clock_get_attributes gethrtime]) AC_CACHE_CHECK([for mach clock_get_time() with monotonic clock type], erl_cv_mach_clock_get_time_monotonic, @@ -766,39 +804,24 @@ AC_DEFUN(ERL_MONOTONIC_CLOCK, erl_cv_mach_clock_get_time_monotonic=no) ]) - case $erl_cv_clock_gettime_monotonic-$ac_cv_func_gethrtime-$erl_cv_mach_clock_get_time_monotonic-$host_os in + erl_corrected_monotonic_clock=no + case $erl_cv_clock_gettime_monotonic_$1-$ac_cv_func_gethrtime-$erl_cv_mach_clock_get_time_monotonic-$host_os in *-*-*-win32) erl_monotonic_clock_func=WindowsAPI ;; CLOCK_*-*-*-linux*) - if test X$cross_compiling != Xyes; then - linux_kernel_vsn_=`uname -r` - case $linux_kernel_vsn_ in - [[0-1]].*|2.[[0-5]]|2.[[0-5]].*) - erl_monotonic_clock_func=times - ;; - *) - erl_monotonic_clock_func=clock_gettime - ;; - esac - else - case X$erl_xcomp_linux_clock_gettime_correction in - X) - AC_MSG_WARN([result clock_gettime guessed because of cross compilation]) - erl_monotonic_clock_func=clock_gettime - ;; - Xyes|Xno) - if test $erl_xcomp_linux_clock_gettime_correction = yes; then - erl_monotonic_clock_func=clock_gettime - else - erl_monotonic_clock_func=times - fi - ;; - *) - AC_MSG_ERROR([Bad erl_xcomp_linux_clock_gettime_correction value: $erl_xcomp_linux_clock_gettime_correction]) - ;; - esac - fi + case $erl_cv_clock_gettime_monotonic_$1-$erl_cv_clock_gettime_monotonic_raw in + CLOCK_BOOTTIME-yes|CLOCK_MONOTONIC-yes) + erl_corrected_monotonic_clock=yes + ;; + *) + # We don't trust CLOCK_MONOTONIC to be NTP + # adjusted on linux systems that do not have + # CLOCK_MONOTONIC_RAW (although it seems to + # be...) + ;; + esac + erl_monotonic_clock_func=clock_gettime ;; no-no-no-linux*) erl_monotonic_clock_func=times @@ -817,16 +840,26 @@ AC_DEFUN(ERL_MONOTONIC_CLOCK, ;; esac + erl_monotonic_clock_low_resolution=no erl_monotonic_clock_lib= erl_monotonic_clock_id= case $erl_monotonic_clock_func in clock_gettime) - erl_monotonic_clock_id="$erl_cv_clock_gettime_monotonic" + erl_monotonic_clock_id=$erl_cv_clock_gettime_monotonic_$1 + for low_res_id in $low_resolution_clock_gettime_monotonic; do + if test $erl_monotonic_clock_id = $low_res_id; then + erl_monotonic_clock_low_resolution=yes + break + fi + done AC_CHECK_LIB(rt, clock_gettime, [erl_monotonic_clock_lib="-lrt"]) ;; mach_clock_get_time) erl_monotonic_clock_id=SYSTEM_CLOCK ;; + times) + erl_monotonic_clock_low_resolution=yes + ;; *) ;; esac @@ -835,9 +868,32 @@ AC_DEFUN(ERL_MONOTONIC_CLOCK, AC_DEFUN(ERL_WALL_CLOCK, [ - AC_CACHE_CHECK([for clock_gettime() with wall clock type], erl_cv_clock_gettime_wall, + default_resolution_clock_gettime_wall="CLOCK_REALTIME" + low_resolution_clock_gettime_wall="CLOCK_REALTIME_COARSE CLOCK_REALTIME_FAST" + high_resolution_clock_gettime_wall="CLOCK_REALTIME_PRECISE" + + case "$1" in + high_resolution) + check_msg="high resolution " + prefer_resolution_clock_gettime_wall="$high_resolution_clock_gettime_wall" + ;; + low_resolution) + check_msg="low resolution " + prefer_resolution_clock_gettime_wall="$low_resolution_clock_gettime_wall" + ;; + custom_resolution) + check_msg="custom resolution " + prefer_resolution_clock_gettime_wall="$2" + ;; + *) + check_msg="" + prefer_resolution_clock_gettime_wall= + ;; + esac + + AC_CACHE_CHECK([for clock_gettime() with ${check_msg}wall clock type], erl_cv_clock_gettime_wall_$1, [ - for clock_type in CLOCK_REALTIME; do + for clock_type in $prefer_resolution_clock_gettime_wall $default_resolution_clock_gettime_wall $high_resolution_clock_gettime_wall $low_resolution_clock_gettime_wall; do AC_TRY_COMPILE([ #include <time.h> ], @@ -848,12 +904,12 @@ AC_DEFUN(ERL_WALL_CLOCK, result = ((long long) ts.tv_sec) * 1000000000LL + ((long long) ts.tv_nsec); ], - erl_cv_clock_gettime_wall=$clock_type, - erl_cv_clock_gettime_wall=no) - test $erl_cv_clock_gettime_wall = no || break + erl_cv_clock_gettime_wall_$1=$clock_type, + erl_cv_clock_gettime_wall_$1=no) + test $erl_cv_clock_gettime_wall_$1 = no || break done ]) - + AC_CHECK_FUNCS([clock_getres clock_get_attributes gettimeofday]) AC_CACHE_CHECK([for mach clock_get_time() with wall clock type], erl_cv_mach_clock_get_time_wall, @@ -875,10 +931,12 @@ AC_DEFUN(ERL_WALL_CLOCK, erl_cv_mach_clock_get_time_wall=no) ]) + erl_wall_clock_low_resolution=no erl_wall_clock_id= - case $erl_cv_clock_gettime_wall-$erl_cv_mach_clock_get_time_wall-$ac_cv_func_gettimeofday-$host_os in + case $erl_cv_clock_gettime_wall_$1-$erl_cv_mach_clock_get_time_wall-$ac_cv_func_gettimeofday-$host_os in *-*-*-win32) erl_wall_clock_func=WindowsAPI + erl_wall_clock_low_resolution=yes ;; no-yes-*-*) erl_wall_clock_func=mach_clock_get_time @@ -886,7 +944,13 @@ AC_DEFUN(ERL_WALL_CLOCK, ;; CLOCK_*-*-*-*) erl_wall_clock_func=clock_gettime - erl_wall_clock_id=$erl_cv_clock_gettime_wall + erl_wall_clock_id=$erl_cv_clock_gettime_wall_$1 + for low_res_id in $low_resolution_clock_gettime_wall; do + if test $erl_wall_clock_id = $low_res_id; then + erl_wall_clock_low_resolution=yes + break + fi + done ;; no-no-yes-*) erl_wall_clock_func=gettimeofday @@ -1401,7 +1465,7 @@ AC_ARG_WITH(with_sparc_memory_order, LM_CHECK_THR_LIB ERL_INTERNAL_LIBS -ERL_MONOTONIC_CLOCK +ERL_MONOTONIC_CLOCK(high_resolution) case $erl_monotonic_clock_func in clock_gettime) @@ -2128,20 +2192,89 @@ dnl ---------------------------------------------------------------------- dnl dnl ERL_TIME_CORRECTION dnl -dnl In the presence of a high resolution realtime timer Erlang can adapt -dnl its view of time relative to this timer. On solaris such a timer is -dnl available with the syscall gethrtime(). On other OS's a fallback -dnl solution using times() is implemented. (However on e.g. FreeBSD times() -dnl is implemented using gettimeofday so it doesn't make much sense to -dnl use it there...) On second thought, it seems to be safer to do it the -dnl other way around. I.e. only use times() on OS's where we know it will -dnl work... +dnl Check for primitives that can be used for implementing +dnl erts_os_monotonic_time() and erts_os_system_time() dnl AC_DEFUN(ERL_TIME_CORRECTION, [ -ERL_WALL_CLOCK +AC_ARG_WITH(clock-resolution, +AS_HELP_STRING([--with-clock-resolution=high|low|default], + [specify wanted clock resolution)])) + +AC_ARG_WITH(clock-gettime-realtime-id, +AS_HELP_STRING([--with-clock-gettime-realtime-id=CLOCKID], + [specify clock id to use with clock_gettime() for realtime time)])) + +AC_ARG_WITH(clock-gettime-monotonic-id, +AS_HELP_STRING([--with-clock-gettime-monotonic-id=CLOCKID], + [specify clock id to use with clock_gettime() for monotonic time)])) + +case "$with_clock_resolution" in + ""|no|yes) + with_clock_resolution=default;; + high|low|default) + ;; + *) + AC_MSG_ERROR([Invalid wanted clock resolution: $with_clock_resolution]) + ;; +esac + +case "$with_clock_gettime_realtime_id" in + ""|no) + with_clock_gettime_realtime_id=no + ;; + CLOCK_*CPUTIME*) + AC_MSG_ERROR([Invalid clock_gettime() realtime clock id: Refusing to use the cputime clock id $with_clock_gettime_realtime_id as realtime clock id]) + ;; + CLOCK_MONOTONIC*|CLOCK_BOOTTIME*|CLOCK_UPTIME*|CLOCK_HIGHRES*) + AC_MSG_ERROR([Invalid clock_gettime() realtime clock id: Refusing to use the monotonic clock id $with_clock_gettime_realtime_id as realtime clock id]) + ;; + CLOCK_*) + ;; + *) + AC_MSG_ERROR([Invalid clock_gettime() clock id: $with_clock_gettime_realtime_id]) + ;; +esac + +case "$with_clock_gettime_monotonic_id" in + ""|no) + with_clock_gettime_monotonic_id=no + ;; + CLOCK_*CPUTIME*) + AC_MSG_ERROR([Invalid clock_gettime() monotonic clock id: Refusing to use the cputime clock id $with_clock_gettime_monotonic_id as monotonic clock id]) + ;; + CLOCK_REALTIME*|CLOCK_TAI*) + AC_MSG_ERROR([Invalid clock_gettime() monotonic clock id: Refusing to use the realtime clock id $with_clock_gettime_monotonic_id as monotonic clock id]) + ;; + CLOCK_*) + ;; + *) + AC_MSG_ERROR([Invalid clock_gettime() clock id: $with_clock_gettime_monotonic_id]) + ;; +esac + +case "$with_clock_resolution-$with_clock_gettime_realtime_id" in + high-no) + ERL_WALL_CLOCK(high_resolution);; + low-no) + ERL_WALL_CLOCK(low_resolution);; + default-no) + ERL_WALL_CLOCK(default_resolution);; + *) + ERL_WALL_CLOCK(custom_resolution, $with_clock_gettime_realtime_id);; +esac + +case "$erl_wall_clock_func-$erl_wall_clock_id-$with_clock_gettime_realtime_id" in + *-*-no) + ;; + clock_gettime-$with_clock_gettime_realtime_id-$with_clock_gettime_realtime_id) + ;; + *) + AC_MSG_ERROR([$with_clock_gettime_realtime_id as clock id to clock_gettime() doesn't compile]) + ;; +esac case $erl_wall_clock_func in mach_clock_get_time) @@ -2162,7 +2295,26 @@ if test "x$erl_wall_clock_id" != "x"; then AC_DEFINE_UNQUOTED(WALL_CLOCK_ID, [$erl_wall_clock_id], [Define to wall clock id to use]) fi -ERL_MONOTONIC_CLOCK +case "$with_clock_resolution-$with_clock_gettime_monotonic_id" in + high-no) + ERL_MONOTONIC_CLOCK(high_resolution);; + low-no) + ERL_MONOTONIC_CLOCK(low_resolution);; + default-no) + ERL_MONOTONIC_CLOCK(default_resolution);; + *) + ERL_MONOTONIC_CLOCK(custom_resolution, $with_clock_gettime_monotonic_id);; +esac + +case "$erl_monotonic_clock_func-$erl_monotonic_clock_id-$with_clock_gettime_monotonic_id" in + *-*-no) + ;; + clock_gettime-$with_clock_gettime_monotonic_id-$with_clock_gettime_monotonic_id) + ;; + *) + AC_MSG_ERROR([$with_clock_gettime_monotonic_id as clock id to clock_gettime() doesn't compile]) + ;; +esac case $erl_monotonic_clock_func in times) @@ -2181,12 +2333,54 @@ case $erl_monotonic_clock_func in ;; esac +if test $erl_corrected_monotonic_clock = yes; then + AC_DEFINE(ERTS_HAVE_CORRECTED_OS_MONOTONIC_TIME, [1], [Define if OS monotonic clock is corrected]) +fi + +if test $erl_monotonic_clock_low_resolution = yes; then + AC_DEFINE(ERTS_HAVE_LOW_RESOLUTION_OS_MONOTONIC_LOW, [1], [Define if you have a low resolution OS monotonic clock]) +fi + xrtlib="$erl_monotonic_clock_lib" if test "x$erl_monotonic_clock_id" != "x"; then AC_DEFINE_UNQUOTED(MONOTONIC_CLOCK_ID_STR, ["$erl_monotonic_clock_id"], [Define as a string of monotonic clock id to use]) AC_DEFINE_UNQUOTED(MONOTONIC_CLOCK_ID, [$erl_monotonic_clock_id], [Define to monotonic clock id to use]) fi +if test $erl_cv_clock_gettime_monotonic_raw = yes; then + AC_DEFINE(HAVE_CLOCK_GETTIME_MONOTONIC_RAW, [1], [Define if you have clock_gettime(CLOCK_MONOTONIC_RAW, _)]) +fi + +ERL_MONOTONIC_CLOCK(high_resolution) + +case $$erl_monotonic_clock_low_resolution-$erl_monotonic_clock_func in + no-mach_clock_get_time) + monotonic_hrtime=yes + AC_DEFINE(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME, [1], [Define if you want to implement erts_os_hrtime() using mach clock_get_time()]) + ;; + no-clock_gettime) + monotonic_hrtime=yes + AC_DEFINE(SYS_HRTIME_USING_CLOCK_GETTIME, [1], [Define if you want to implement erts_os_hrtime() using clock_gettime()]) + ;; + no-gethrtime) + monotonic_hrtime=yes + AC_DEFINE(SYS_HRTIME_USING_GETHRTIME, [1], [Define if you want to implement erts_os_hrtime() using gethrtime()]) + ;; + *) + monotonic_hrtime=no + ;; +esac + +if test $monotonic_hrtime = yes; then + AC_DEFINE(HAVE_MONOTONIC_ERTS_SYS_HRTIME, [1], [Define if you have a monotonic erts_os_hrtime() implementation]) +fi + +if test "x$erl_monotonic_clock_id" != "x"; then + AC_DEFINE_UNQUOTED(HRTIME_CLOCK_ID_STR, ["$erl_monotonic_clock_id"], [Define as a string of monotonic clock id to use]) + AC_DEFINE_UNQUOTED(HRTIME_CLOCK_ID, [$erl_monotonic_clock_id], [Define to monotonic clock id to use]) +fi + + dnl dnl Check if gethrvtime is working, and if to use procfs ioctl dnl or (yet to be written) write to the procfs ctl file. diff --git a/erts/configure.in b/erts/configure.in index 91c06973ac..62515fe081 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -317,15 +317,6 @@ if test X"$use_vm_probes" = X"yes"; then [Define to enable VM dynamic trace probes]) fi - -AC_ARG_ENABLE(clock-gettime, -AS_HELP_STRING([--enable-clock-gettime], - [use clock-gettime for time correction]), -[ case "$enableval" in - no) clock_gettime_correction=no ;; - *) clock_gettime_correction=yes ;; - esac ], clock_gettime_correction=unknown) - AC_ARG_WITH(assumed-cache-line-size, AS_HELP_STRING([--with-assumed-cache-line-size=SIZE], [specify assumed cache line size in bytes (valid values are powers of two between and including 16 and 8192; default is 64)])) @@ -1769,6 +1760,10 @@ AC_CHECK_HEADER(sys/event.h, have_kernel_poll=kqueue) AC_CHECK_HEADER(sys/epoll.h, have_kernel_poll=epoll) AC_CHECK_HEADER(sys/devpoll.h, have_kernel_poll=/dev/poll) +dnl Check if we have timerfds to be used for high accuracy +dnl epoll_wait timeouts +AC_CHECK_HEADERS([sys/timerfd.h]) + dnl Check for kernel SCTP support AC_SUBST(LIBSCTP) if test "x$enable_sctp" != "xno" ; then @@ -2114,7 +2109,7 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop gethrtime localtime_r gmtime_r inet_pton \ memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ - setlocale nl_langinfo poll mlockall]) + setlocale nl_langinfo poll mlockall ppoll]) AC_MSG_CHECKING([for isfinite]) AC_TRY_LINK([#include <math.h>], @@ -2917,6 +2912,10 @@ else #include <signal.h> #include <stdlib.h> +#if defined(__clang__) || defined(__llvm__) +#error "Clang/LLVM generates broken code for FP exceptions" +#endif + volatile int erl_fp_exception; /* @@ -4692,18 +4691,30 @@ AC_SUBST(os_mon_programs) AC_SUBST(CPU_SUP_LIBS) AC_CHECK_LIB(kstat, kstat_open, [ - os_mon_programs="$os_mon_programs cpu_sup" + use_cpu_sup=yes CPU_SUP_LIBS="$CPU_SUP_LIBS -lkstat" ]) +AC_CHECK_LIB(kvm, kvm_open, [ + use_cpu_sup=yes + CPU_SUP_LIBS="$CPU_SUP_LIBS -lkvm" + ]) + case $host_os in solaris2*) os_mon_programs="$os_mon_programs ferrule mod_syslog" ;; + darwin*) + use_cpu_sup=yes ;; + openbsd*) + use_cpu_sup=yes ;; linux*) - os_mon_programs="$os_mon_programs cpu_sup" ;; + use_cpu_sup=yes ;; esac - +if test "$use_cpu_sup" = "yes"; then + os_mon_programs="$os_mon_programs cpu_sup" +fi + AC_ARG_WITH(javac, AS_HELP_STRING([--with-javac=JAVAC], [specify Java compiler to use]) AS_HELP_STRING([--with-javac], [use a Java compiler if found (default)]) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index ba5f80a9c1..6ca57566aa 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -536,29 +536,69 @@ </desc> </func> <func> - <name name="cancel_timer" arity="1"/> + <name name="cancel_timer" arity="2"/> <fsummary>Cancel a timer</fsummary> <desc> - <p>Cancels a timer, where <c><anno>TimerRef</anno></c> was returned by - either - <seealso marker="#send_after/3">erlang:send_after/3</seealso> - or - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>. - If the timer is there to be removed, the function returns - the time in milliseconds left until the timer would have expired, - otherwise <c>false</c> (which means that <c><anno>TimerRef</anno></c> was - never a timer, that it has already been cancelled, or that it - has already delivered its message).</p> + <p>Cancels a timer. <c><anno>TimerRef</anno></c> needs to refer to + a timer that was created by either + <seealso marker="#send_after/4"><c>erlang:send_after()</c></seealso>, + or <seealso marker="#start_timer/4"><c>erlang:start_timer()</c></seealso>.</p> + <p>Currently available <c><anno>Option</anno>s</c>:</p> + <taglist> + <tag><c>{async, Async}</c></tag> + <item> + <p>Asynchronous request for cancellation. <c>Async</c> + defaults to <c>false</c>. That is the operation will be + performed synchronously. When <c>Async</c> is set to + <c>true</c> the cancel operation will be performed + asynchronously. That is, <c>cancel_timer()</c> will send + a request for cancellation to the timer service that + manages the timer, and then return <c>ok</c>.</p></item> + <tag><c>{info, Info}</c></tag> + <item> + <p>Request information about the <c>Result</c> of the + cancellation. <c>Info</c> defaults to <c>true</c>. That + is information will be given. When <c>Info</c> is set to + <c>false</c> no information about the result of the cancel + operation will be given. When the operation is performed + synchronously the <c>Result</c> will returned from + <c>cancel_timer()</c>. When the operation is performed + asynchronously, a message on the form + <c>{cancel_timer, <anno>TimerRef</anno>, <anno>Result</anno>}</c> + will be sent to the caller of <c>cancel_timer()</c> when + the operation has been performed.</p></item> + </taglist> + <p>When the <c><anno>Result</anno></c> equals <c>false</c> a timer + corresponding to <c><anno>TimerRef</anno></c> could not be found. This + can be either because the timer had expired, been canceled, or because + <c><anno>TimerRef</anno></c> do not correspond to a timer. When the + <c><anno>Result</anno></c> is an integer, it represents + the time in milli seconds left before the timer will expire.</p> + <note><p>The timer service that manages the timer may be co-located + with another scheduler than the scheduler that the calling process + is executing on. In this case communication with the timer + service will be performed using asynchronous signals. If the calling + process is in critical path and can do other things while waiting + for the result of this operation, you want to use the <c>{async, true}</c> + option.</p></note> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#start_timer/4"><c>erlang:start_timer/4</c></seealso>, and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> + <seealso marker="#read_timer/2"><c>erlang:read_timer/2</c></seealso>.</p> <p>Note: Cancelling a timer does not guarantee that the message has not already been delivered to the message queue.</p> </desc> </func> - + <func> + <name name="cancel_timer" arity="1"/> + <fsummary>Cancel a timer</fsummary> + <desc> + <p>Cancels a timer. The same as calling + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer(TimerRef, + [{async, false}, {info, true}])</c></seealso>.</p> + </desc> + </func> <func> <name name="check_old_code" arity="1"/> <fsummary>Check if a module has old code</fsummary> @@ -4505,23 +4545,54 @@ os_prompt% </pre> </desc> </func> <func> - <name name="read_timer" arity="1"/> - <fsummary>Number of milliseconds remaining for a timer</fsummary> - <desc> - <p><c><anno>TimerRef</anno></c> is a timer reference returned by - <seealso marker="#send_after/3">erlang:send_after/3</seealso> - or - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>. - If the timer is active, the function returns the time in - milliseconds left until the timer will expire, otherwise - <c>false</c> (which means that <c><anno>TimerRef</anno></c> was never a - timer, that it has been cancelled, or that it has already - delivered its message).</p> + <name name="read_timer" arity="2"/> + <fsummary>Read the state of a timer</fsummary> + <desc> + <p>Read the state of a timer. <c><anno>TimerRef</anno></c> + needs to refer to a timer that was created by either + <seealso marker="#send_after/4"><c>erlang:send_after()</c></seealso>, + or <seealso marker="#start_timer/4"><c>erlang:start_timer()</c></seealso>.</p> + <p>Currently available <c><anno>Option</anno>s</c>:</p> + <taglist> + <tag><c>{async, Async}</c></tag> + <item> + <p>Asynchronous request. <c>Async</c> defaults to <c>false</c>. That + is the operation will be performed synchronously, and the <c>Result</c> + will returned from <c>read_timer()</c>. When <c>Async</c> is set to + <c>true</c>, <c>read_timer()</c> will send a request for the + <c>Result</c> to a timer service that manages the timer and then + return <c>ok</c>. A message on the format + <c>{read_timer, <anno>TimerRef</anno>, <anno>Result</anno>}</c> + will be sent to the caller of <c>read_timer()</c> when + the operation has been processed.</p></item> + </taglist> + <p>When the <c><anno>Result</anno></c> equals <c>false</c> a timer + corresponding to <c><anno>TimerRef</anno></c> could not be found. This + can be either because the timer had expired, been canceled, or because + <c><anno>TimerRef</anno></c> do not correspond to a timer. When the + <c><anno>Result</anno></c> is an integer, it represents + the time in milli seconds left before the timer will expire.</p> + <note><p>The timer service that manages the timer may be co-located + with another scheduler than the scheduler that the calling process + is executing on. In this case communication with the timer + service will be performed using asynchronous signals. If the calling + process is in critical path and can do other things while waiting + for the result of this operation, you want to use the <c>{async, true}</c> + option.</p></note> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#start_timer/4"><c>erlang:start_timer/4</c></seealso>, and - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>.</p> + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="read_timer" arity="1"/> + <fsummary>Read the state of a timer</fsummary> + <desc> + <p>Read the state of a timer. The same as calling + <seealso marker="#read_timer/2"><c>erlang:read_timer(TimerRef, + [{async, false}])</c></seealso>.</p> </desc> </func> <func> @@ -4670,6 +4741,63 @@ true</pre> </desc> </func> <func> + <name name="send_after" arity="4"/> + <fsummary>Start a timer</fsummary> + <desc> + <p>Starts a timer. When the timer expires, the message + <c><anno>Msg</anno></c> will be sent to + <c><anno>Dest</anno></c>.</p> + <p>If <c><anno>Dest</anno></c> is a <c>pid()</c> it has to + be a <c>pid()</c> of a local process, dead or alive.</p> + <p>Currently available <c><anno>Option</anno>s</c>:</p> + <taglist> + <tag><c>{abs, Abs}</c></tag> + <item> + <p>Absolute timeout. When <c>Abs</c> is <c>false</c> + the <c><anno>Time</anno></c> value will be interpreted + as a time in milli-seconds relative current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. When <c>Abs</c> is <c>true</c> the + <c><anno>Time</anno></c> value will be interpreted as an absolute + Erlang monotonic time of milli second time unit. <c>Abs</c> + defaults to <c>false</c>.</p> + </item> + </taglist> + <p>The absolute time when the timer is set to expire needs + to be in the range between + <seealso marker="#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso> + and + <seealso marker="#system_info_end_time"><c>erlang:system_info(end_time)</c></seealso>. + If a negative relative time is specified the time is not + allowed to be negative.</p> + <p>If <c><anno>Dest</anno></c> is an <c>atom()</c>, it is supposed to be the name of + a registered process. The process referred to by the name is + looked up at the time of delivery. No error is given if + the name does not refer to a process.</p> + <p>If <c><anno>Dest</anno></c> is a <c>pid()</c>, the timer will be automatically + canceled if the process referred to by the <c>pid()</c> is not alive, + or when the process exits. This feature was introduced in + erts version 5.4.11. Note that timers will not be + automatically canceled when <c><anno>Dest</anno></c> is an <c>atom()</c>.</p> + <p>See also + <seealso marker="#start_timer/4"><c>erlang:send_timer/4</c></seealso>, + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer/2</c></seealso>, + and + <seealso marker="#read_timer/2"><c>erlang:read_timer/2</c></seealso>.</p> + <p>Failure: <c>badarg</c> if the arguments does not satisfy + the requirements specified above.</p> + </desc> + </func> + <func> + <name name="send_after" arity="3"/> + <fsummary>Start a timer</fsummary> + <desc> + <p>Starts a timer. The same as calling + <seealso marker="#send_timer/4"><c>erlang:send_after(<anno>Time</anno>, + <anno>Dest</anno>, <anno>Msg</anno>, [{abs, false}])</c></seealso>.</p> + </desc> + </func> + <func> <name name="send_after" arity="3"/> <type_desc variable="Time">0 <= Time <= 4294967295</type_desc> <fsummary>Start a timer</fsummary> @@ -4690,9 +4818,9 @@ true</pre> automatically canceled when <c><anno>Dest</anno></c> is an <c>atom</c>.</p> <p>See also <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>, + <seealso marker="#cancel_timer/2">erlang:cancel_timer/2</seealso>, and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> + <seealso marker="#read_timer/2">erlang:read_timer/2</seealso>.</p> <p>Failure: <c>badarg</c> if the arguments does not satisfy the requirements specified above.</p> </desc> @@ -5100,15 +5228,35 @@ true</pre> </desc> </func> <func> - <name name="start_timer" arity="3"/> - <type_desc variable="Time">0 <= Time <= 4294967295</type_desc> + <name name="start_timer" arity="4"/> <fsummary>Start a timer</fsummary> <desc> - <p>Starts a timer which will send the message - <c>{timeout, <anno>TimerRef</anno>, <anno>Msg</anno>}</c> to <c><anno>Dest</anno></c> - after <c><anno>Time</anno></c> milliseconds.</p> - <p>If <c><anno>Dest</anno></c> is a <c>pid()</c> it has to be a <c>pid()</c> of a local process, dead or alive.</p> - <p>The <c><anno>Time</anno></c> value can, in the current implementation, not be greater than 4294967295.</p> + <p>Starts a timer. When the timer expires, the message + <c>{timeout, <anno>TimerRef</anno>, <anno>Msg</anno>}</c> + will be sent to <c><anno>Dest</anno></c>.</p> + <p>If <c><anno>Dest</anno></c> is a <c>pid()</c> it has to + be a <c>pid()</c> of a local process, dead or alive.</p> + <p>Currently available <c><anno>Option</anno>s</c>:</p> + <taglist> + <tag><c>{abs, Abs}</c></tag> + <item> + <p>Absolute timeout. When <c>Abs</c> is <c>false</c> + the <c><anno>Time</anno></c> value will be interpreted + as a time in milli-seconds relative current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. When <c>Abs</c> is <c>true</c> the + <c><anno>Time</anno></c> value will be interpreted as an absolute + Erlang monotonic time of milli second time unit. <c>Abs</c> + defaults to <c>false</c>.</p> + </item> + </taglist> + <p>The absolute time when the timer is set to expire needs + to be in the range between + <seealso marker="#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso> + and + <seealso marker="#system_info_end_time"><c>erlang:system_info(end_time)</c></seealso>. + If a negative relative time is specified the time is not + allowed to be negative.</p> <p>If <c><anno>Dest</anno></c> is an <c>atom()</c>, it is supposed to be the name of a registered process. The process referred to by the name is looked up at the time of delivery. No error is given if @@ -5119,15 +5267,24 @@ true</pre> erts version 5.4.11. Note that timers will not be automatically canceled when <c><anno>Dest</anno></c> is an <c>atom()</c>.</p> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer/2</c></seealso>, and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> + <seealso marker="#read_timer/2"><c>erlang:read_timer/2</c></seealso>.</p> <p>Failure: <c>badarg</c> if the arguments does not satisfy the requirements specified above.</p> </desc> </func> <func> + <name name="start_timer" arity="3"/> + <fsummary>Start a timer</fsummary> + <desc> + <p>Starts a timer. The same as calling + <seealso marker="#start_timer/4"><c>erlang:start_timer(<anno>Time</anno>, + <anno>Dest</anno>, <anno>Msg</anno>, [{abs, false}])</c></seealso>.</p> + </desc> + </func> + <func> <name name="statistics" arity="1" clause_i="1"/> <fsummary>Information about context switches</fsummary> <desc> @@ -6236,6 +6393,14 @@ ok (i.e. <c>system_info(dynamic_trace)</c> returns <c>dtrace</c> or <c>systemtap</c>).</p> </item> + <tag><marker id="system_info_end_time"/><c>end_time</c></tag> + <item><p>The last <seealso marker="#monotonic_time/0">Erlang monotonic + time</seealso> in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso> that + can be represented internally in the current Erlang runtime system + instance. The time between the + <seealso marker="#system_info_start_time">start time</seealso> and + the end time is at least a quarter of a millennium.</p></item> <tag><c>elib_malloc</c></tag> <item> <p>This option will be removed in a future release. diff --git a/erts/doc/src/time_correction.xml b/erts/doc/src/time_correction.xml index 979a37d7ff..8af98acc19 100644 --- a/erts/doc/src/time_correction.xml +++ b/erts/doc/src/time_correction.xml @@ -137,6 +137,14 @@ <p>The correctness of time values.</p> </section> + <marker id="Time_Warp"/> + <section> + <title>Time Warp</title> + <p>A time warp is a leap forwards or backwards in time. That + is, the difference of time values taken before and after the + time warp will not correspond to the actual elapsed time.</p> + </section> + <marker id="OS_System_Time"/> <section> <title>OS System Time</title> @@ -146,7 +154,7 @@ <seealso marker="kernel:os#system_time/0"><c>os:system_time()</c></seealso>. This may or may not be an accurate view of POSIX time. This time may typically be adjusted both backwards and forwards without - limitation. That is, huge leaps both backwards and forwards in time + limitation. That is, <seealso marker="#Time_Warp">time warps</seealso> may be observed. You can get information about the Erlang runtime system's source of OS system time by calling <seealso marker="erlang#system_info_os_system_time_source"><c>erlang:system_info(os_system_time_source)</c></seealso>.</p> @@ -159,12 +167,12 @@ system. This time does not leap and have a relatively steady frequency although not completely correct. However, it is not uncommon that the OS monotonic time stops if the system is - suspended. This time typically increase since some unspecified - point in time that is not connected to - <seealso marker="#OS_System_Time">OS system time</seealso>. Note that - this type of time is not necessarily provided by all operating - systems. You can get information about the Erlang runtime - system's source of OS monotonic time by calling + suspended. This time typically increase since some + unspecified point in time that is not connected to + <seealso marker="#OS_System_Time">OS system time</seealso>. Note + that this type of time is not necessarily provided by all + operating systems. You can get information about the Erlang + runtime system's source of OS monotonic time by calling <seealso marker="erlang#system_info_os_monotonic_time_source"><c>erlang:system_info(os_monotonic_time_source)</c></seealso>.</p> </section> @@ -177,9 +185,11 @@ <seealso marker="erlang#system_time/0"><c>erlang:system_time()</c></seealso>. This time may or may not be an accurate view of POSIX time, and may or may not align with <seealso marker="#OS_System_Time">OS system - time</seealso>. The <seealso marker="#Time_Warp_Modes">time - warp mode</seealso> determines how it behaves when OS system - time suddenly change.</p> + time</seealso>. The runtime system works towards aligning the two + system times. Depending on <seealso marker="#Time_Warp_Modes">time + warp mode</seealso> used, this may be achieved by letting the Erlang + system time perform a <seealso marker="#Time_Warp">time + warp</seealso>.</p> </section> <marker id="Erlang_Monotonic_Time"/> @@ -219,12 +229,6 @@ </p> </section> - <marker id="Time_Warp"/> - <section> - <title>Time Warp</title> - <p>A time warp is a leap forwards or backwards in time.</p> - </section> - </section> <section> @@ -332,7 +336,7 @@ <section> <title>Time Warp Safe Code</title> <p>Time warp safe code is code that is able to handle - a time warp of + a <seealso marker="#Time_Warp">time warp</seealso> of <seealso marker="#Erlang_System_Time">Erlang system time</seealso>. </p> @@ -378,11 +382,11 @@ <p>The time offset is determined at runtime system start and will after this not change. This is the default behavior. Not because it is the best mode (which it isn't). It is - default only because this is how the runtime system always - has behaved until ERTS version 7.0, and you have to ensure - that your Erlang code that may execute during a time warp is - <seealso marker="#Time_Warp_Safe_Code">time warp safe</seealso> - before you can enable other modes.</p> + default <em>only</em> because this is how the runtime system + always has behaved up until ERTS version 7.0, and you have to + ensure that your Erlang code that may execute during a time + warp is <seealso marker="#Time_Warp_Safe_Code">time warp + safe</seealso> before you can enable other modes.</p> <p>Since the time offset is not allowed to change, time correction needs to adjust the frequency of the Erlang @@ -422,9 +426,9 @@ system time has been corrected, you may want to use the single time warp mode. Note that there are limitations to when you can execute time warp unsafe code using this mode. If it is possible - to only utilize time warp safe code, it is much better to use - the <seealso marker="#Multi_Time_Warp_Mode">multi time warp - mode</seealso> instead. + to only utilize time warp safe code, it is <em>much</em> better + to use the <seealso marker="#Multi_Time_Warp_Mode">multi time + warp mode</seealso> instead. </p> <p>Using the single time warp mode, the time offset is @@ -438,12 +442,14 @@ current OS system time is determined. This offset will from now on be fixed during the whole preliminary phase.</p> - <p>If time correction is enabled, the Erlang - monotonic clock will only use the OS monotonic time as - time source during this phase. That is, during the - preliminary phase changes in OS system time will have - no effect on Erlang system time and/or Erlang - monotonic time what so ever.</p> + <p>If time correction is enabled, adjustments to the + Erlang monotonic clock will be made to keep its + frequency as correct as possible, but <em>no</em> + adjustments will be made trying to align Erlang system + time and OS system time. That is, during the preliminary + Erlang system time and OS system time might diverge + from each other, and no attempt to prevent this will + be made.</p> <p>If time correction is disabled, changes in OS system time will effect the monotonic clock the same way as @@ -462,15 +468,16 @@ <p>During finalization, the time offset is adjusted and fixated so that current Erlang system time align with - current OS system time. Since the time offset - may be changed, the Erlang system time may do - a time warp at this point. The time offset will from - now on be fixed until the runtime system terminates. - If time correction has been enabled, the time correction - also begins when this phase begins. When the system is - in the final phase it behaves exactly as in the - <seealso marker="#No_Time_Warp_Mode">no time warp - mode</seealso>.</p> + current OS system time. Since the time offset may + change during the finalization, the Erlang system time + may do a time warp at this point. The time offset will + from now on be fixed until the runtime system terminates. + If time correction has been enabled, the time + correction will from now on also make adjustments + in order to align Erlang system time with OS system + time. When the system is in the final phase it behaves + exactly as in the <seealso marker="#No_Time_Warp_Mode">no + time warp mode</seealso>.</p> </item> </taglist> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index b4a17e76e7..659ea1b27f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -779,7 +779,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_fun.o $(OBJDIR)/erl_bif_port.o \ $(OBJDIR)/erl_term.o $(OBJDIR)/erl_node_tables.o \ $(OBJDIR)/erl_monitors.o $(OBJDIR)/erl_process_dump.o \ - $(OBJDIR)/erl_bif_timer.o $(OBJDIR)/erl_cpu_topology.o \ + $(OBJDIR)/erl_hl_timer.o $(OBJDIR)/erl_cpu_topology.o \ $(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \ $(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \ $(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 8fdcbb4058..5ec1409adf 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -68,6 +68,7 @@ atom aborted atom abs_path atom absoluteURI atom ac +atom accessor atom active atom all atom all_but_first @@ -94,12 +95,14 @@ atom args atom arg0 atom arity atom asn1 +atom async atom asynchronous atom atom atom atom_used atom attributes atom await_port_send_result atom await_proc_exit +atom await_result atom await_sched_wall_time_modifications atom awaiting_load atom awaiting_unload diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index df1983a83d..500a98195b 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -39,12 +39,9 @@ static void set_default_trace_pattern(Eterm module); static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp); static void delete_code(Module* modp); static void decrement_refc(BeamInstr* code); -static int is_native(BeamInstr* code); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); - - BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) { Module* modp; @@ -59,8 +56,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) return am_undefined; } erts_rlock_old_code(code_ix); - res = ((modp->curr.code && is_native(modp->curr.code)) || - (modp->old.code != 0 && is_native(modp->old.code))) ? + res = (erts_is_module_native(modp->curr.code) || + erts_is_module_native(modp->old.code)) ? am_true : am_false; erts_runlock_old_code(code_ix); return res; @@ -371,7 +368,7 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, ASSERT(commiter_state.stager == NULL); commiter_state.stager = c_p; erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); - erts_smp_proc_inc_refc(c_p); + erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* * smp_code_ix_commiter() will do the rest "later" @@ -398,7 +395,7 @@ static void smp_code_ix_commiter(void* null) erts_resume(p, ERTS_PROC_LOCK_STATUS); } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_proc_dec_refc(p); + erts_proc_dec_refc(p); } #endif /* ERTS_SMP */ @@ -1106,25 +1103,3 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) } return NIL; } - -static int -is_native(BeamInstr* code) -{ - Uint i, num_functions = code[MI_NUM_FUNCTIONS]; - - /* Check NativeAdress of first real function in module - */ - for (i=0; i<num_functions; i++) { - BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; - Eterm name = (Eterm) func_info[3]; - - if (is_atom(name)) { - return func_info[1] != 0; - } - else ASSERT(is_nil(name)); /* ignore BIF stubs */ - } - /* Not a single non-BIF function? */ - return 0; -} - - diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 21faf8fbf2..a21622f424 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -2119,44 +2119,32 @@ void process_main(void) } GetArg1(1, timeout_value); if (timeout_value != make_small(0)) { -#if !defined(ARCH_64) || HALFWORD_HEAP - Uint time_val; -#endif - if (is_small(timeout_value) && signed_val(timeout_value) > 0 && -#if defined(ARCH_64) && !HALFWORD_HEAP - ((unsigned_val(timeout_value) >> 32) == 0) -#else - 1 -#endif - ) { - /* - * The timer routiner will set c_p->i to the value in - * c_p->def_arg_reg[0]. Note that it is safe to use this - * location because there are no living x registers in - * a receive statement. - * Note that for the halfword emulator, the two first elements - * of the array are used. - */ - BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; - *pi = I+3; - set_timer(c_p, unsigned_val(timeout_value)); - } else if (timeout_value == am_infinity) { + if (timeout_value == am_infinity) c_p->flags |= F_TIMO; -#if !defined(ARCH_64) || HALFWORD_HEAP - } else if (term_to_Uint(timeout_value, &time_val)) { - BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; - *pi = I+3; - set_timer(c_p, time_val); -#endif - } else { /* Wrong time */ - OpCase(i_wait_error_locked): { - erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - /* Fall through */ + else { + int tres = erts_set_proc_timer_term(c_p, timeout_value); + if (tres == 0) { + /* + * The timer routiner will set c_p->i to the value in + * c_p->def_arg_reg[0]. Note that it is safe to use this + * location because there are no living x registers in + * a receive statement. + * Note that for the halfword emulator, the two first elements + * of the array are used. + */ + BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; + *pi = I+3; } + else { /* Wrong time */ + OpCase(i_wait_error_locked): { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Fall through */ + } OpCase(i_wait_error): { - c_p->freason = EXC_TIMEOUT_VALUE; - goto find_func_info; + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; + } } } @@ -2205,7 +2193,7 @@ void process_main(void) if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { BeamInstr** p = (BeamInstr **) c_p->def_arg_reg; *p = I+3; - set_timer(c_p, Arg(1)); + erts_set_proc_timer_uword(c_p, Arg(1)); } goto wait2; } @@ -5589,18 +5577,35 @@ next_catch(Process* c_p, Eterm *reg) { static void terminate_proc(Process* c_p, Eterm Value) { + Eterm *hp; + Eterm Args = NIL; + /* Add a stacktrace if this is an error. */ if (GET_EXC_CLASS(c_p->freason) == EXTAG_ERROR) { Value = add_stacktrace(c_p, Value, c_p->ftrace); } /* EXF_LOG is a primary exception flag */ if (c_p->freason & EXF_LOG) { + int alive = erts_is_alive; erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Error in process %T ", c_p->common.id); - if (erts_is_alive) - erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname); - erts_dsprintf(dsbufp,"with exit value: %0.*T\n", display_items, Value); - erts_send_error_to_logger(c_p->group_leader, dsbufp); + + /* Build the format message */ + erts_dsprintf(dsbufp, "Error in process ~p "); + if (alive) + erts_dsprintf(dsbufp, "on node ~p "); + erts_dsprintf(dsbufp, "with exit value:~n~p~n"); + + /* Build the args in reverse order */ + hp = HAlloc(c_p, 2); + Args = CONS(hp, Value, Args); + if (alive) { + hp = HAlloc(c_p, 2); + Args = CONS(hp, erts_this_node->sysname, Args); + } + hp = HAlloc(c_p, 2); + Args = CONS(hp, c_p->common.id, Args); + + erts_send_error_term_to_logger(c_p->group_leader, dsbufp, Args); } /* * If we use a shared heap, the process will be garbage-collected. @@ -5946,7 +5951,7 @@ build_stacktrace(Process* c_p, Eterm exc) { * (e.g. spawn_link(erlang, abs, [1])). */ if (fi.current == NULL) { - erts_set_current_function(&fi, c_p->initial); + erts_set_current_function(&fi, c_p->u.initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 282aa71109..0d40201934 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -530,6 +530,7 @@ static Eterm functions_in_module(Process* p, Eterm mod); static Eterm attributes_for_module(Process* p, Eterm mod); static Eterm compilation_info_for_module(Process* p, Eterm mod); static Eterm md5_of_module(Process* p, Eterm mod); +static Eterm has_native(Process* p, Eterm mod); static Eterm native_addresses(Process* p, Eterm mod); int patch_funentries(Eterm Patchlist); int patch(Eterm Addresses, Uint fe); @@ -5408,6 +5409,9 @@ erts_module_info_0(Process* p, Eterm module) list = CONS(hp, tup, list) BUILD_INFO(am_md5); +#ifdef HIPE + BUILD_INFO(am_native); +#endif BUILD_INFO(am_compile); BUILD_INFO(am_attributes); BUILD_INFO(am_exports); @@ -5433,6 +5437,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) return compilation_info_for_module(p, module); } else if (what == am_native_addresses) { return native_addresses(p, module); + } else if (what == am_native) { + return has_native(p, module); } return THE_NON_VALUE; } @@ -5493,6 +5499,53 @@ functions_in_module(Process* p, /* Process whose heap to use. */ } /* + * Returns 'true' if mod has any native compiled functions, otherwise 'false' + */ + +static Eterm +has_native(Process* p, Eterm mod) +{ + Eterm result = am_false; +#ifdef HIPE + Module* modp; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod, erts_active_code_ix()); + if (modp == NULL) { + return THE_NON_VALUE; + } + + if (erts_is_module_native(modp->curr.code)) { + result = am_true; + } +#endif + return result; +} + +int +erts_is_module_native(BeamInstr* code) +{ + Uint i, num_functions; + + /* Check NativeAdress of first real function in module */ + if (code != NULL) { + num_functions = code[MI_NUM_FUNCTIONS]; + for (i=0; i<num_functions; i++) { + BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + Eterm name = (Eterm) func_info[3]; + if (is_atom(name)) { + return func_info[1] != 0; + } + else ASSERT(is_nil(name)); /* ignore BIF stubs */ + } + } + return 0; +} + +/* * Builds a list of all functions including native addresses. * [{Name,Arity,NativeAddress},...] * @@ -5695,7 +5748,11 @@ md5_of_module(Process* p, /* Process whose heap to use. */ return THE_NON_VALUE; } code = modp->curr.code; - res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + if (code[MI_MD5_PTR] != 0) { + res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + } else { + res = am_undefined; + } return res; } @@ -6168,6 +6225,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) LoaderState* stp; BeamInstr Funcs; BeamInstr Patchlist; + Eterm MD5Bin; Eterm* tp; BeamInstr* code = NULL; BeamInstr* ptrs; @@ -6196,12 +6254,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) goto error; } tp = tuple_val(Info); - if (tp[0] != make_arityval(2)) { + if (tp[0] != make_arityval(3)) { goto error; } Funcs = tp[1]; - Patchlist = tp[2]; - + Patchlist = tp[2]; + MD5Bin = tp[3]; + if (is_not_binary(MD5Bin) || (binary_size(MD5Bin) != MD5_SIZE)) { + goto error; + } if ((n = erts_list_length(Funcs)) < 0) { goto error; } @@ -6251,6 +6312,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr); code_size += stp->chunks[ATTR_CHUNK].size; code_size += stp->chunks[COMPILE_CHUNK].size; + code_size += MD5_SIZE; code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size); if (!code) { goto error; @@ -6357,6 +6419,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) if (info == NULL) { goto error; } + { + byte *tmp = NULL; + byte *md5 = NULL; + if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) { + sys_memcpy(info, md5, MD5_SIZE); + code[MI_MD5_PTR] = (BeamInstr) info; + } + erts_free_aligned_binary_bytes(tmp); + } /* * Insert the module in the module table. diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 0e3ca0bdb0..46b0c60ab0 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -23,10 +23,10 @@ #include "beam_opcodes.h" #include "erl_process.h" +int erts_is_module_native(BeamInstr* code); Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module); - typedef struct gen_op_entry { char* name; int arity; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 4f2958c664..2b782f4484 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -44,6 +44,7 @@ #include "erl_bits.h" #include "erl_bif_unique.h" +Export *erts_await_result; static Export* flush_monitor_messages_trap = NULL; static Export* set_cpu_topology_trap = NULL; static Export* await_proc_exit_trap = NULL; @@ -831,26 +832,6 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) return ret; } -BIF_RETTYPE erts_internal_monitor_process_2(BIF_ALIST_2) -{ - if (is_not_internal_pid(BIF_ARG_1)) { - if (is_external_pid(BIF_ARG_1) - && (external_pid_dist_entry(BIF_ARG_1) - == erts_this_dist_entry)) { - BIF_RET(am_false); - } - goto badarg; - } - - if (is_not_internal_ref(BIF_ARG_2)) - goto badarg; - - BIF_RET(local_pid_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, 1)); - -badarg: - BIF_ERROR(BIF_P, BADARG); -} - /**********************************************************************/ /* this is a combination of the spawn and link BIFs */ @@ -4904,6 +4885,10 @@ void erts_init_bif(void) #endif , &bif_return_trap); + erts_await_result = erts_export_put(am_erts_internal, + am_await_result, + 1); + erts_init_trap_export(&dsend_continue_trap_export, am_erts_internal, am_dsend_continue_trap, 1, dsend_continue_trap_1); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index d461c3f479..b877711544 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -20,6 +20,7 @@ #ifndef __BIF_H__ #define __BIF_H__ +extern Export *erts_await_result; extern Export* erts_format_cpu_topology_trap; extern Export *erts_convert_time_unit_trap; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 471f687101..eadba3eaff 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -171,11 +171,6 @@ bif erts_internal:map_hashmap_children/1 bif erts_internal:time_unit/0 -bif erts_internal:get_bif_timer_servers/0 -bif erts_internal:create_bif_timer/0 -bif erts_internal:access_bif_timer/1 - -bif erts_internal:monitor_process/2 bif erts_internal:is_system_process/1 # inet_db support @@ -220,6 +215,15 @@ bif math:sqrt/1 bif math:atan2/2 bif math:pow/2 +bif erlang:start_timer/3 +bif erlang:start_timer/4 +bif erlang:send_after/3 +bif erlang:send_after/4 +bif erlang:cancel_timer/1 +bif erlang:cancel_timer/2 +bif erlang:read_timer/1 +bif erlang:read_timer/2 + bif erlang:make_tuple/2 bif erlang:append_element/2 bif erlang:make_tuple/3 diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index e2fa572546..02e65cb9c6 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -36,7 +36,7 @@ #include "atom.h" #include "beam_load.h" #include "erl_instrument.h" -#include "erl_bif_timer.h" +#include "erl_hl_timer.h" #include "erl_thr_progress.h" /* Forward declarations -- should really appear somewhere else */ @@ -108,7 +108,7 @@ process_killer(void) case 'k': { ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; erts_aint32_t state; - erts_smp_proc_inc_refc(rp); + erts_proc_inc_refc(rp); erts_smp_proc_lock(rp, rp_locks); state = erts_smp_atomic32_read_acqb(&rp->state); if (state & (ERTS_PSFLG_FREE @@ -131,7 +131,7 @@ process_killer(void) 0); } erts_smp_proc_unlock(rp, rp_locks); - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } case 'n': br = 1; break; case 'r': return; @@ -227,9 +227,9 @@ print_process_info(int to, void *to_arg, Process *p) * Display the initial function name */ erts_print(to, to_arg, "Spawned as: %T:%T/%bpu\n", - p->initial[INITIAL_MOD], - p->initial[INITIAL_FUN], - p->initial[INITIAL_ARI]); + p->u.initial[INITIAL_MOD], + p->u.initial[INITIAL_FUN], + p->u.initial[INITIAL_ARI]); if (p->current != NULL) { if (running) { diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index 4344558348..d925709bd0 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -130,7 +130,7 @@ int erts_try_seize_code_write_permission(Process* c_p) ASSERT(code_writing_process != c_p); qitem = erts_alloc(ERTS_ALC_T_CODE_IX_LOCK_Q, sizeof(*qitem)); qitem->p = c_p; - erts_smp_proc_inc_refc(c_p); + erts_proc_inc_refc(c_p); qitem->next = code_write_queue; code_write_queue = qitem; erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); @@ -151,7 +151,7 @@ void erts_release_code_write_permission(void) } erts_smp_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS); code_write_queue = qitem->next; - erts_smp_proc_dec_refc(qitem->p); + erts_proc_dec_refc(qitem->p); erts_free(ERTS_ALC_T_CODE_IX_LOCK_Q, qitem); } code_writing_process = NULL; diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 4d12dae787..850606dd86 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -608,11 +608,6 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) erts_refc_inc(&funp->fe->refc, 2); } goto off_heap_common; - - case MAP_SUBTAG: - *hp++ = *tp++; - sz--; - break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: @@ -648,7 +643,6 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } *hpp = hp; - return res; } diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index e396395dde..dcae5509ec 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -39,7 +39,7 @@ #include "erl_instrument.h" #include "erl_mseg.h" #include "erl_monitors.h" -#include "erl_bif_timer.h" +#include "erl_hl_timer.h" #include "erl_cpu_topology.h" #include "erl_thr_queue.h" #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) @@ -575,6 +575,15 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)] = sizeof(ErtsThrQElement_t); #endif + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_LL_PTIMER)] + = erts_timer_type_size(ERTS_ALC_T_LL_PTIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_HL_PTIMER)] + = erts_timer_type_size(ERTS_ALC_T_HL_PTIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_BIF_TIMER)] + = erts_timer_type_size(ERTS_ALC_T_BIF_TIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_ABIF_TIMER)] + = erts_timer_type_size(ERTS_ALC_T_ABIF_TIMER); + #ifdef HARD_DEBUG hdbg_init(); #endif @@ -2322,6 +2331,22 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_MSG_REF); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_LL_PTIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_HL_PTIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_BIF_TIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_ABIF_TIMER); } if (want.atom || want.atom_used) { @@ -3186,7 +3211,7 @@ reply_alloc_info(void *vair) rp_locks &= ~ERTS_PROC_LOCK_MAIN; erts_smp_proc_unlock(rp, rp_locks); - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) aireq_free(air); @@ -3260,7 +3285,7 @@ erts_request_alloc_info(struct process *c_p, erts_smp_atomic32_init_nob(&air->refc, (erts_aint32_t) erts_no_schedulers); - erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + erts_proc_add_refc(c_p, (Sint) erts_no_schedulers); #ifdef ERTS_SMP if (erts_no_schedulers > 1) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 074f864dee..57c506458c 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -163,9 +163,13 @@ type MSG_ROOTS TEMPORARY PROCESSES msg_roots type ROOTSET TEMPORARY PROCESSES root_set type LOADER_TMP TEMPORARY CODE loader_tmp type PREPARED_CODE SHORT_LIVED CODE prepared_code -type BIF_TIMER_TABLE LONG_LIVED SYSTEM bif_timer_table -type SL_BIF_TIMER SHORT_LIVED PROCESSES bif_timer_sl -type LL_BIF_TIMER STANDARD PROCESSES bif_timer_ll +type TIMER_SERVICE LONG_LIVED SYSTEM timer_service +type LL_PTIMER FIXED_SIZE PROCESSES ll_ptimer +type HL_PTIMER FIXED_SIZE PROCESSES hl_ptimer +type BIF_TIMER FIXED_SIZE PROCESSES bif_timer +type ABIF_TIMER FIXED_SIZE PROCESSES accessor_bif_timer +type TIMER_REQUEST SHORT_LIVED PROCESSES timer_request +type BTM_YIELD_STATE SHORT_LIVED PROCESSES btm_yield_state type REG_TABLE STANDARD SYSTEM reg_tab type FUN_TABLE STANDARD CODE fun_tab type DIST_TABLE STANDARD SYSTEM dist_tab @@ -324,8 +328,6 @@ type ACTIVE_PROCS STANDARD PROCESSES active_procs +endif +if smp -type SL_PTIMER SHORT_LIVED SYSTEM ptimer_sl -type LL_PTIMER STANDARD SYSTEM ptimer_ll type SYS_MSG_Q SHORT_LIVED PROCESSES system_messages_queue type FP_EXCEPTION LONG_LIVED SYSTEM fp_exception type LL_MPATHS LONG_LIVED SYSTEM ll_migration_paths @@ -365,7 +367,6 @@ type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap -type BIF_TIMER_DATA LONG_LIVED_LOW SYSTEM bif_timer_data +else # "fullword" @@ -386,7 +387,6 @@ 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 BIF_TIMER_DATA LONG_LIVED SYSTEM bif_timer_data +endif diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index fa7de23f00..f74aea80a7 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1054,9 +1054,9 @@ process_info_aux(Process *BIF_P, case am_initial_call: hp = HAlloc(BIF_P, 3+4); res = TUPLE3(hp, - rp->initial[INITIAL_MOD], - rp->initial[INITIAL_FUN], - make_small(rp->initial[INITIAL_ARI])); + rp->u.initial[INITIAL_MOD], + rp->u.initial[INITIAL_FUN], + make_small(rp->u.initial[INITIAL_ARI])); hp += 4; break; @@ -2129,6 +2129,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(erts_has_time_correction() ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("start_time", BIF_ARG_1)) { BIF_RET(erts_get_monotonic_start_time(BIF_P)); + } else if (ERTS_IS_ATOM_STR("end_time", BIF_ARG_1)) { + BIF_RET(erts_get_monotonic_end_time(BIF_P)); } else if (ERTS_IS_ATOM_STR("time_warp_mode", BIF_ARG_1)) { switch (erts_time_warp_mode()) { case ERTS_NO_TIME_WARP_MODE: { diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c deleted file mode 100644 index ac4a5644ac..0000000000 --- a/erts/emulator/beam/erl_bif_timer.c +++ /dev/null @@ -1,849 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "erl_bif_timer.h" -#include "global.h" -#include "bif.h" -#include "error.h" -#include "big.h" -#include "erl_thr_progress.h" -#include "erl_bif_unique.h" - -/**************************************************************************** -** BIF Timer support -****************************************************************************/ - -#define BTM_FLG_SL_TIMER (((Uint32) 1) << 0) -#define BTM_FLG_CANCELED (((Uint32) 1) << 1) -#define BTM_FLG_HEAD (((Uint32) 1) << 2) -#define BTM_FLG_BYNAME (((Uint32) 1) << 3) -#define BTM_FLG_WRAP (((Uint32) 1) << 4) - -struct ErtsBifTimer_ { - struct { - union { - ErtsBifTimer **head; - ErtsBifTimer *prev; - } u; - ErtsBifTimer *next; - } tab; - union { - Eterm name; - struct { - ErtsBifTimer *prev; - ErtsBifTimer *next; - Process *ess; - } proc; - } receiver; - ErlTimer tm; - ErlHeapFragment* bp; - Uint32 flags; - Eterm message; - Uint32 ref_numbers[ERTS_REF_NUMBERS]; -}; - -#ifdef SMALL_MEMORY -#define TIMER_HASH_VEC_SZ 3331 -#define BTM_PREALC_SZ 10 -#else -#define TIMER_HASH_VEC_SZ 10007 -#define BTM_PREALC_SZ 100 -#endif -static ErtsBifTimer **bif_timer_tab; -static Uint no_bif_timers; - - -static erts_smp_rwmtx_t bif_timer_lock; - -#define erts_smp_safe_btm_rwlock(P, L) \ - safe_btm_lock((P), (L), 1) -#define erts_smp_safe_btm_rlock(P, L) \ - safe_btm_lock((P), (L), 0) -#define erts_smp_btm_rwlock() \ - erts_smp_rwmtx_rwlock(&bif_timer_lock) -#define erts_smp_btm_tryrwlock() \ - erts_smp_rwmtx_tryrwlock(&bif_timer_lock) -#define erts_smp_btm_rwunlock() \ - erts_smp_rwmtx_rwunlock(&bif_timer_lock) -#define erts_smp_btm_rlock() \ - erts_smp_rwmtx_rlock(&bif_timer_lock) -#define erts_smp_btm_tryrlock() \ - erts_smp_rwmtx_tryrlock(&bif_timer_lock) -#define erts_smp_btm_runlock() \ - erts_smp_rwmtx_runlock(&bif_timer_lock) -#define erts_smp_btm_lock_init() \ - erts_smp_rwmtx_init(&bif_timer_lock, "bif_timers") - - -static ERTS_INLINE int -safe_btm_lock(Process *c_p, ErtsProcLocks c_p_locks, int rw_lock) -{ - ASSERT(c_p && c_p_locks); -#ifdef ERTS_SMP - if ((rw_lock ? erts_smp_btm_tryrwlock() : erts_smp_btm_tryrlock()) != EBUSY) - return 0; - erts_smp_proc_unlock(c_p, c_p_locks); - if (rw_lock) - erts_smp_btm_rwlock(); - else - erts_smp_btm_rlock(); - erts_smp_proc_lock(c_p, c_p_locks); - if (ERTS_PROC_IS_EXITING(c_p)) { - if (rw_lock) - erts_smp_btm_rwunlock(); - else - erts_smp_btm_runlock(); - return 1; - } -#endif - return 0; -} - -ERTS_SCHED_PREF_PALLOC_IMPL(btm_pre, ErtsBifTimer, BTM_PREALC_SZ) - -static ERTS_INLINE int -get_index(Uint32 *ref_numbers, Uint32 len) -{ - Uint32 hash; - /* len can potentially be larger than ERTS_REF_NUMBERS - if it has visited another node... */ - if (len > ERTS_REF_NUMBERS) - len = ERTS_REF_NUMBERS; - -#if ERTS_REF_NUMBERS != 3 -#error "ERTS_REF_NUMBERS changed. Update me..." -#endif - switch (len) { - case 3: if (!ref_numbers[2]) len = 2; - case 2: if (!ref_numbers[1]) len = 1; - default: break; - } - - ASSERT(1 <= len && len <= ERTS_REF_NUMBERS); - - hash = block_hash((byte *) ref_numbers, len * sizeof(Uint32), 0x08d12e65); - return (int) (hash % ((Uint32) TIMER_HASH_VEC_SZ)); -} - -static Eterm -create_ref(Uint *hp, Uint32 *ref_numbers, Uint32 len) -{ - Uint32 *datap; - int i; - - - if (len > ERTS_MAX_REF_NUMBERS) { - /* Such large refs should no be able to appear in the emulator */ - erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); - } - -#if defined(ARCH_64) && !HALFWORD_HEAP - hp[0] = make_ref_thing_header(len/2 + 1); - datap = (Uint32 *) &hp[1]; - *(datap++) = len; -#else - hp[0] = make_ref_thing_header(len); - datap = (Uint32 *) &hp[1]; -#endif - - for (i = 0; i < len; i++) - datap[i] = ref_numbers[i]; - - return make_internal_ref(hp); -} - -static int -eq_non_standard_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2) -{ -#if defined(ARCH_64) && !HALFWORD_HEAP -#define MAX_REF_HEAP_SZ (1+(ERTS_MAX_REF_NUMBERS/2+1)) -#else -#define MAX_REF_HEAP_SZ (1+ERTS_MAX_REF_NUMBERS) -#endif - DeclareTmpHeapNoproc(r1_hp,(MAX_REF_HEAP_SZ * 2)); - Eterm *r2_hp = r1_hp +MAX_REF_HEAP_SZ; - - return eq(create_ref(r1_hp, rn1, len1), create_ref(r2_hp, rn2, len2)); -#undef MAX_REF_HEAP_SZ -} - -static ERTS_INLINE int -eq_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2) -{ - int res; - if (len1 != ERTS_REF_NUMBERS || len2 != ERTS_REF_NUMBERS) { - /* Can potentially happen, but will never... */ - return eq_non_standard_ref_numbers(rn1, len1, rn2, len2); - } - -#if ERTS_REF_NUMBERS != 3 -#error "ERTS_REF_NUMBERS changed. Update me..." -#endif - res = rn1[0] == rn2[0] && rn1[1] == rn2[1] && rn1[2] == rn2[2]; - - ASSERT(res - ? eq_non_standard_ref_numbers(rn1, len1, rn2, len2) - : !eq_non_standard_ref_numbers(rn1, len1, rn2, len2)); - - return res; -} - -static ERTS_INLINE ErtsBifTimer * -tab_find(Eterm ref) -{ - Uint32 *ref_numbers = internal_ref_numbers(ref); - Uint32 ref_numbers_len = internal_ref_no_of_numbers(ref); - int ix = get_index(ref_numbers, ref_numbers_len); - ErtsBifTimer* btm; - - for (btm = bif_timer_tab[ix]; btm; btm = btm->tab.next) - if (eq_ref_numbers(ref_numbers, ref_numbers_len, - btm->ref_numbers, ERTS_REF_NUMBERS)) - return btm; - return NULL; -} - -static ERTS_INLINE void -tab_remove(ErtsBifTimer* btm) -{ - if (btm->flags & BTM_FLG_HEAD) { - *btm->tab.u.head = btm->tab.next; - if (btm->tab.next) { - btm->tab.next->flags |= BTM_FLG_HEAD; - btm->tab.next->tab.u.head = btm->tab.u.head; - } - } - else { - btm->tab.u.prev->tab.next = btm->tab.next; - if (btm->tab.next) - btm->tab.next->tab.u.prev = btm->tab.u.prev; - } - btm->flags |= BTM_FLG_CANCELED; - ASSERT(no_bif_timers > 0); - no_bif_timers--; -} - -static ERTS_INLINE void -tab_insert(ErtsBifTimer* btm) -{ - int ix = get_index(btm->ref_numbers, ERTS_REF_NUMBERS); - ErtsBifTimer* btm_list = bif_timer_tab[ix]; - - if (btm_list) { - btm_list->flags &= ~BTM_FLG_HEAD; - btm_list->tab.u.prev = btm; - } - - btm->flags |= BTM_FLG_HEAD; - btm->tab.u.head = &bif_timer_tab[ix]; - btm->tab.next = btm_list; - bif_timer_tab[ix] = btm; - no_bif_timers++; -} - -static ERTS_INLINE void -link_proc(Process *p, ErtsBifTimer* btm) -{ - btm->receiver.proc.ess = p; - btm->receiver.proc.prev = NULL; - btm->receiver.proc.next = p->u.bif_timers; - if (p->u.bif_timers) - p->u.bif_timers->receiver.proc.prev = btm; - p->u.bif_timers = btm; -} - -static ERTS_INLINE void -unlink_proc(ErtsBifTimer* btm) -{ - if (btm->receiver.proc.prev) - btm->receiver.proc.prev->receiver.proc.next = btm->receiver.proc.next; - else - btm->receiver.proc.ess->u.bif_timers = btm->receiver.proc.next; - if (btm->receiver.proc.next) - btm->receiver.proc.next->receiver.proc.prev = btm->receiver.proc.prev; -} - -static void -bif_timer_cleanup(ErtsBifTimer* btm) -{ - ASSERT(btm); - - if (btm->bp) - free_message_buffer(btm->bp); - - if (!btm_pre_free(btm)) { - if (btm->flags & BTM_FLG_SL_TIMER) - erts_free(ERTS_ALC_T_SL_BIF_TIMER, (void *) btm); - else - erts_free(ERTS_ALC_T_LL_BIF_TIMER, (void *) btm); - } -} - -static void -bif_timer_timeout(ErtsBifTimer* btm) -{ - ASSERT(btm); - - - erts_smp_btm_rwlock(); - - if (btm->flags & BTM_FLG_CANCELED) { - /* - * A concurrent cancel is ongoing. Do not send the timeout message, - * but cleanup here since the cancel call-back won't be called. - */ -#ifndef ERTS_SMP - ASSERT(0); -#endif - } - else { - ErtsProcLocks rp_locks = 0; - Process* rp; - - tab_remove(btm); - - ASSERT(!erts_get_current_process()); - - if (btm->flags & BTM_FLG_BYNAME) - rp = erts_whereis_process(NULL, 0, btm->receiver.name, 0, 0); - else { - rp = btm->receiver.proc.ess; - unlink_proc(btm); - } - - if (rp) { - Eterm message; - ErlHeapFragment *bp; - - bp = btm->bp; - btm->bp = NULL; /* Prevent cleanup of message buffer... */ - - if (!(btm->flags & BTM_FLG_WRAP)) - message = btm->message; - else { -#if ERTS_REF_NUMBERS != 3 -#error "ERTS_REF_NUMBERS changed. Update me..." -#endif - Eterm ref; - Uint *hp; - Uint wrap_size = REF_THING_SIZE + 4; - message = btm->message; - - if (!bp) { - ErlOffHeap *ohp; - ASSERT(is_immed(message)); - hp = erts_alloc_message_heap(wrap_size, - &bp, - &ohp, - rp, - &rp_locks); - } else { - Eterm old_size = bp->used_size; - bp = erts_resize_message_buffer(bp, old_size + wrap_size, - &message, 1); - hp = &bp->mem[0] + old_size; - } - - write_ref_thing(hp, - btm->ref_numbers[0], - btm->ref_numbers[1], - btm->ref_numbers[2]); - ref = make_internal_ref(hp); - hp += REF_THING_SIZE; - message = TUPLE3(hp, am_timeout, ref, message); - } - - erts_queue_message(rp, &rp_locks, bp, message, NIL); - erts_smp_proc_unlock(rp, rp_locks); - } - } - - erts_smp_btm_rwunlock(); - - bif_timer_cleanup(btm); -} - -static Eterm -setup_bif_timer(Uint32 xflags, - Process *c_p, - Eterm time, - Eterm receiver, - Eterm message) -{ - Process *rp; - ErtsBifTimer* btm; - Uint timeout; - Eterm ref; - Uint32 *ref_numbers; - - if (!term_to_Uint(time, &timeout)) - return THE_NON_VALUE; -#if defined(ARCH_64) && !HALFWORD_HEAP - if ((timeout >> 32) != 0) - return THE_NON_VALUE; -#endif - if (is_not_internal_pid(receiver) && is_not_atom(receiver)) - return THE_NON_VALUE; - - ref = erts_make_ref(c_p); - - if (is_atom(receiver)) - rp = NULL; - else { - rp = erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN, - receiver, ERTS_PROC_LOCK_MSGQ); - if (!rp) - return ref; - } - - if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) { - if (timeout < 1000) { - btm = btm_pre_alloc(); - if (!btm) - goto sl_timer_alloc; - btm->flags = 0; - } - else { - sl_timer_alloc: - btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_SL_BIF_TIMER, - sizeof(ErtsBifTimer)); - btm->flags = BTM_FLG_SL_TIMER; - } - } - else { - btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_LL_BIF_TIMER, - sizeof(ErtsBifTimer)); - btm->flags = 0; - } - - if (rp) { - link_proc(rp, btm); - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); - } - else { - ASSERT(is_atom(receiver)); - btm->receiver.name = receiver; - btm->flags |= BTM_FLG_BYNAME; - } - - btm->flags |= xflags; - - ref_numbers = internal_ref_numbers(ref); - ASSERT(internal_ref_no_of_numbers(ref) == 3); -#if ERTS_REF_NUMBERS != 3 -#error "ERTS_REF_NUMBERS changed. Update me..." -#endif - btm->ref_numbers[0] = ref_numbers[0]; - btm->ref_numbers[1] = ref_numbers[1]; - btm->ref_numbers[2] = ref_numbers[2]; - - ASSERT(eq_ref_numbers(btm->ref_numbers, ERTS_REF_NUMBERS, - ref_numbers, ERTS_REF_NUMBERS)); - - if (is_immed(message)) { - btm->bp = NULL; - btm->message = message; - } - else { - ErlHeapFragment* bp; - Eterm* hp; - Uint size; - - size = size_object(message); - btm->bp = bp = new_message_buffer(size); - hp = bp->mem; - btm->message = copy_struct(message, size, &hp, &bp->off_heap); - } - - tab_insert(btm); - ASSERT(btm == tab_find(ref)); - erts_init_timer(&btm->tm); - erts_set_timer(&btm->tm, - (ErlTimeoutProc) bif_timer_timeout, - (ErlCancelProc) bif_timer_cleanup, - (void *) btm, - timeout); - return ref; -} - -BIF_RETTYPE old_send_after_3(BIF_ALIST_3); -/* send_after(Time, Pid, Message) -> Ref */ -BIF_RETTYPE old_send_after_3(BIF_ALIST_3) -{ - Eterm res; - - if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) - ERTS_BIF_EXITED(BIF_P); - - res = setup_bif_timer(0, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); - - erts_smp_btm_rwunlock(); - - if (is_non_value(res)) { - BIF_ERROR(BIF_P, BADARG); - } - else { - ASSERT(is_internal_ref(res)); - BIF_RET(res); - } -} - -BIF_RETTYPE old_start_timer_3(BIF_ALIST_3); -/* start_timer(Time, Pid, Message) -> Ref */ -BIF_RETTYPE old_start_timer_3(BIF_ALIST_3) -{ - Eterm res; - - if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) - ERTS_BIF_EXITED(BIF_P); - - res = setup_bif_timer(BTM_FLG_WRAP, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); - - erts_smp_btm_rwunlock(); - - if (is_non_value(res)) { - BIF_ERROR(BIF_P, BADARG); - } - else { - ASSERT(is_internal_ref(res)); - BIF_RET(res); - } -} - -BIF_RETTYPE old_cancel_timer_1(BIF_ALIST_1); -/* cancel_timer(Ref) -> false | RemainingTime */ -BIF_RETTYPE old_cancel_timer_1(BIF_ALIST_1) -{ - Eterm res; - ErtsBifTimer *btm; - - if (is_not_internal_ref(BIF_ARG_1)) { - if (is_ref(BIF_ARG_1)) { - BIF_RET(am_false); - } - BIF_ERROR(BIF_P, BADARG); - } - - if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) - ERTS_BIF_EXITED(BIF_P); - - btm = tab_find(BIF_ARG_1); - if (!btm || btm->flags & BTM_FLG_CANCELED) { - erts_smp_btm_rwunlock(); - res = am_false; - } - else { - Uint left = erts_time_left(&btm->tm); - if (!(btm->flags & BTM_FLG_BYNAME)) { - erts_smp_proc_lock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ); - unlink_proc(btm); - erts_smp_proc_unlock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ); - } - tab_remove(btm); - ASSERT(!tab_find(BIF_ARG_1)); - erts_cancel_timer(&btm->tm); - erts_smp_btm_rwunlock(); - res = erts_make_integer(left, BIF_P); - } - - BIF_RET(res); -} - -BIF_RETTYPE old_read_timer_1(BIF_ALIST_1); -/* read_timer(Ref) -> false | RemainingTime */ -BIF_RETTYPE old_read_timer_1(BIF_ALIST_1) -{ - Eterm res; - ErtsBifTimer *btm; - - if (is_not_internal_ref(BIF_ARG_1)) { - if (is_ref(BIF_ARG_1)) { - BIF_RET(am_false); - } - BIF_ERROR(BIF_P, BADARG); - } - - if (erts_smp_safe_btm_rlock(BIF_P, ERTS_PROC_LOCK_MAIN)) - ERTS_BIF_EXITED(BIF_P); - - btm = tab_find(BIF_ARG_1); - if (!btm || btm->flags & BTM_FLG_CANCELED) { - res = am_false; - } - else { - Uint left = erts_time_left(&btm->tm); - res = erts_make_integer(left, BIF_P); - } - - erts_smp_btm_runlock(); - - BIF_RET(res); -} - -void -erts_print_bif_timer_info(int to, void *to_arg) -{ - int i; - int lock = !ERTS_IS_CRASH_DUMPING; - - if (lock) - erts_smp_btm_rlock(); - - for (i = 0; i < TIMER_HASH_VEC_SZ; i++) { - ErtsBifTimer *btm; - for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) { - Eterm receiver = (btm->flags & BTM_FLG_BYNAME - ? btm->receiver.name - : btm->receiver.proc.ess->common.id); - erts_print(to, to_arg, "=timer:%T\n", receiver); - erts_print(to, to_arg, "Message: %T\n", btm->message); - erts_print(to, to_arg, "Time left: %u\n", - erts_time_left(&btm->tm)); - } - } - - if (lock) - erts_smp_btm_runlock(); -} - - -void -erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks) -{ - ErtsBifTimer *btm; - - if (erts_smp_btm_tryrwlock() == EBUSY) { - erts_smp_proc_unlock(p, plocks); - erts_smp_btm_rwlock(); - erts_smp_proc_lock(p, plocks); - } - - btm = p->u.bif_timers; - while (btm) { - ErtsBifTimer *tmp_btm; - ASSERT(!(btm->flags & BTM_FLG_CANCELED)); - tab_remove(btm); - tmp_btm = btm; - btm = btm->receiver.proc.next; - erts_cancel_timer(&tmp_btm->tm); - } - - p->u.bif_timers = NULL; - - erts_smp_btm_rwunlock(); -} - -static void erts_old_bif_timer_init(void) -{ - int i; - no_bif_timers = 0; - init_btm_pre_alloc(); - erts_smp_btm_lock_init(); - bif_timer_tab = erts_alloc(ERTS_ALC_T_BIF_TIMER_TABLE, - sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ); - for (i = 0; i < TIMER_HASH_VEC_SZ; ++i) - bif_timer_tab[i] = NULL; -} - -Uint -erts_bif_timer_memory_size(void) -{ - Uint res; - int lock = !ERTS_IS_CRASH_DUMPING; - - if (lock) - erts_smp_btm_rlock(); - - res = (sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ - + no_bif_timers*sizeof(ErtsBifTimer)); - - if (lock) - erts_smp_btm_runlock(); - - return res; -} - - -void -erts_bif_timer_foreach(void (*func)(Eterm, Eterm, ErlHeapFragment *, void *), - void *arg) -{ - int i; - - ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); - - for (i = 0; i < TIMER_HASH_VEC_SZ; i++) { - ErtsBifTimer *btm; - for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) { - (*func)((btm->flags & BTM_FLG_BYNAME - ? btm->receiver.name - : btm->receiver.proc.ess->common.id), - btm->message, - btm->bp, - arg); - } - } -} - -typedef struct { - Uint ref_heap[REF_THING_SIZE]; - Eterm pid[1]; -} ErtsBifTimerServers; - -static ErtsBifTimerServers *bif_timer_servers; - -void erts_bif_timer_init(void) -{ - erts_old_bif_timer_init(); -} - -void -erts_bif_timer_start_servers(Eterm parent) -{ - Process *parent_proc; - Eterm *hp, btr_ref, arg_list_end; - ErlSpawnOpts so; - int i; - - bif_timer_servers = erts_alloc(ERTS_ALC_T_BIF_TIMER_DATA, - (sizeof(ErtsBifTimerServers) - + (sizeof(Eterm)*(erts_no_schedulers-1)))); - - so.flags = SPO_USE_ARGS|SPO_SYSTEM_PROC|SPO_PREFER_SCHED|SPO_OFF_HEAP_MSGS; - so.min_heap_size = H_MIN_SIZE; - so.min_vheap_size = BIN_VH_MIN_SIZE; - so.priority = PRIORITY_MAX; - so.max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs); - - /* - * Parent is "init" and schedulers have not yet been started, so it - * *should* be alive and well... - */ - ASSERT(is_internal_pid(parent)); - parent_proc = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc, - internal_pid_index(parent)); - ASSERT(parent_proc); - ASSERT(parent_proc->common.id == parent); - ASSERT(!ERTS_PROC_IS_EXITING(parent_proc)); - - erts_smp_proc_lock(parent_proc, ERTS_PROC_LOCK_MAIN); - - hp = HAlloc(parent_proc, 2*erts_no_schedulers + 2 + REF_THING_SIZE); - - btr_ref = erts_make_ref_in_buffer(hp); - hp += REF_THING_SIZE; - - arg_list_end = CONS(hp, btr_ref, NIL); - hp += 2; - - for (i = 0; i < erts_no_schedulers; i++) { - int sched = i+1; - Eterm arg_list = CONS(hp, make_small(i+1), arg_list_end); - hp += 2; - - so.scheduler = sched; /* Preferred scheduler */ - - bif_timer_servers->pid[i] = erl_create_process(parent_proc, - am_erts_internal, - am_bif_timer_server, - arg_list, - &so); - } - - erts_smp_proc_unlock(parent_proc, ERTS_PROC_LOCK_MAIN); - - hp = internal_ref_val(btr_ref); - for (i = 0; i < REF_THING_SIZE; i++) - bif_timer_servers->ref_heap[i] = hp[i]; -} - -BIF_RETTYPE -erts_internal_get_bif_timer_servers_0(BIF_ALIST_0) -{ - int i; - Eterm *hp, res = NIL; - - hp = HAlloc(BIF_P, erts_no_schedulers*2); - for (i = erts_no_schedulers-1; i >= 0; i--) { - res = CONS(hp, bif_timer_servers->pid[i], res); - hp += 2; - } - BIF_RET(res); -} - -BIF_RETTYPE -erts_internal_access_bif_timer_1(BIF_ALIST_1) -{ - int ix; - Uint32 *rdp; - Eterm ref, pid, *hp, res; - - if (is_not_internal_ref(BIF_ARG_1)) { - if (is_not_ref(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(am_undefined); - } - - rdp = internal_ref_numbers(BIF_ARG_1); - ix = (int) erts_get_ref_numbers_thr_id(rdp); - if (ix < 1 || erts_no_schedulers < ix) - BIF_RET(am_undefined); - - pid = bif_timer_servers->pid[ix-1]; - ASSERT(is_internal_pid(pid)); - - hp = HAlloc(BIF_P, 3 /* 2-tuple */ + REF_THING_SIZE); - for (ix = 0; ix < REF_THING_SIZE; ix++) - hp[ix] = bif_timer_servers->ref_heap[ix]; - ref = make_internal_ref(&hp[0]); - hp += REF_THING_SIZE; - - res = TUPLE2(hp, ref, pid); - BIF_RET(res); -} - -BIF_RETTYPE -erts_internal_create_bif_timer_0(BIF_ALIST_0) -{ - ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(BIF_P); - Eterm *hp, btr_ref, t_ref, pid, res; - int ix; - - hp = HAlloc(BIF_P, 4 /* 3-tuple */ + 2*REF_THING_SIZE); - for (ix = 0; ix < REF_THING_SIZE; ix++) - hp[ix] = bif_timer_servers->ref_heap[ix]; - btr_ref = make_internal_ref(&hp[0]); - hp += REF_THING_SIZE; - - t_ref = erts_sched_make_ref_in_buffer(esdp, hp); - hp += REF_THING_SIZE; - - ASSERT(erts_get_ref_numbers_thr_id(internal_ref_numbers(t_ref)) - == (Uint32) esdp->no); - - pid = bif_timer_servers->pid[((int) esdp->no) - 1]; - - res = TUPLE3(hp, btr_ref, pid, t_ref); - - BIF_RET(res); -} diff --git a/erts/emulator/beam/erl_bif_timer.h b/erts/emulator/beam/erl_bif_timer.h deleted file mode 100644 index c2f5dfd3c3..0000000000 --- a/erts/emulator/beam/erl_bif_timer.h +++ /dev/null @@ -1,37 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - - -#ifndef ERL_BIF_TIMER_H__ -#define ERL_BIF_TIMER_H__ - -typedef struct ErtsBifTimer_ ErtsBifTimer; - -#include "sys.h" -#include "erl_process.h" -#include "erl_message.h" - -Uint erts_bif_timer_memory_size(void); -void erts_print_bif_timer_info(int to, void *to_arg); -void erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks); -void erts_bif_timer_init(void); -void erts_bif_timer_foreach(void (*func)(Eterm,Eterm,ErlHeapFragment *,void *), - void *arg); -void erts_bif_timer_start_servers(Eterm); -#endif diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index ac57205c47..13e0160648 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -359,7 +359,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) ASSERT(finish_bp.stager == NULL); finish_bp.stager = p; erts_schedule_thr_prgr_later_op(smp_bp_finisher, NULL, &finish_bp.lop); - erts_smp_proc_inc_refc(p); + erts_proc_inc_refc(p); erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL); ERTS_BIF_YIELD_RETURN(p, make_small(matches)); } @@ -393,7 +393,7 @@ static void smp_bp_finisher(void* null) erts_resume(p, ERTS_PROC_LOCK_STATUS); } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_proc_dec_refc(p); + erts_proc_dec_refc(p); } } #endif /* ERTS_SMP */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index fff892ae54..2e2cb98354 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -620,7 +620,7 @@ BIF_RETTYPE ets_safe_fixtable_2(BIF_ALIST_2) erts_fprintf(stderr, "ets:safe_fixtable(%T,%T); Process: %T, initial: %T:%T/%bpu\n", BIF_ARG_1, BIF_ARG_2, BIF_P->common.id, - BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]); #endif kind = (BIF_ARG_2 == am_true) ? LCK_READ : LCK_WRITE_REC; @@ -1247,7 +1247,7 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2) erts_fprintf(stderr, "ets:rename(%T,%T); Process: %T, initial: %T:%T/%bpu\n", BIF_ARG_1, BIF_ARG_2, BIF_P->common.id, - BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]); #endif @@ -1563,7 +1563,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) erts_fprintf(stderr, "ets:new(%T,%T)=%T; Process: %T, initial: %T:%T/%bpu\n", BIF_ARG_1, BIF_ARG_2, ret, BIF_P->common.id, - BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]); erts_fprintf(stderr, "ets: new: meta_pid_to_tab common.memory_size = %ld\n", erts_smp_atomic_read_nob(&meta_pid_to_tab->common.memory_size)); erts_fprintf(stderr, "ets: new: meta_pid_to_fixed_tab common.memory_size = %ld\n", @@ -1696,7 +1696,7 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) erts_fprintf(stderr, "ets:delete(%T); Process: %T, initial: %T:%T/%bpu\n", BIF_ARG_1, BIF_P->common.id, - BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]); #endif CHECK_TABLES(); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index d90af46659..c7bccc78c3 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -2716,7 +2716,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, *ret = this; return 1; } else if (partly_bound != NULL && key != am_Underscore && - db_is_variable(key) < 0) + db_is_variable(key) < 0 && !db_has_map(key)) *partly_bound = key; return 0; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 0fb1c397c9..c6c3c55a7e 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2039,7 +2039,7 @@ restart: break; case matchKey: t = (Eterm) *pc++; - tp = erts_maps_get_rel(t, make_flatmap_rel(ep, base), base); + tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base); if (!tp) { FAIL(); } @@ -3347,6 +3347,37 @@ int db_is_variable(Eterm obj) return N; } +/* check if node is (or contains) a map + * return 1 if node contains a map + * return 0 otherwise + */ + +int db_has_map(Eterm node) { + DECLARE_ESTACK(s); + + ESTACK_PUSH(s,node); + while (!ESTACK_ISEMPTY(s)) { + node = ESTACK_POP(s); + if (is_list(node)) { + while (is_list(node)) { + ESTACK_PUSH(s,CAR(list_val(node))); + node = CDR(list_val(node)); + } + ESTACK_PUSH(s,node); /* Non wellformed list or [] */ + } else if (is_tuple(node)) { + Eterm *tuple = tuple_val(node); + int arity = arityval(*tuple); + while(arity--) { + ESTACK_PUSH(s,*(++tuple)); + } + } else if is_map(node) { + DESTROY_ESTACK(s); + return 1; + } + } + DESTROY_ESTACK(s); + return 0; +} /* check if obj is (or contains) a variable */ /* return 1 if obj contains a variable or underscore */ @@ -3380,6 +3411,11 @@ int db_has_variable(Eterm node) { while (size--) { ESTACK_PUSH(s, *(values++)); } + } else if (is_map(node)) { /* other map-nodes or map-heads */ + Eterm *ptr = hashmap_val(node); + int i = hashmap_bitcount(MAP_HEADER_VAL(*ptr)); + ptr += MAP_HEADER_ARITY(*ptr); + while(i--) { ESTACK_PUSH(s, *++ptr); } } break; case TAG_PRIMARY_IMMED1: diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index ca206c7f58..b2d5a306cb 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -342,6 +342,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj, Uint pos, Eterm** hpp, Uint extra); +int db_has_map(Eterm obj); int db_has_variable(Eterm obj); int db_is_variable(Eterm obj); void db_do_update_element(DbUpdateHandle* handle, diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 0b18d2b9e8..1785fc27be 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -97,10 +97,10 @@ typedef struct { static Uint setup_rootset(Process*, Eterm*, int, Rootset*); static void cleanup_rootset(Rootset *rootset); -static Uint combined_message_size(Process* p, int off_heap_msgs); +static Uint combined_message_size(Process* p); static void remove_message_buffers(Process* p); -static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int off_heap_msgs); -static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int off_heap_msgs); +static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); +static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj); static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size); static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size); @@ -403,9 +403,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { Uint reclaimed_now = 0; int done = 0; - int off_heap_msgs; - Uint ms1, s1, us1; - erts_aint32_t state; + ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); @@ -422,11 +420,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) trace_gc(p, am_gc_start); } - state = erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); - off_heap_msgs = state & ERTS_PSFLG_OFF_HEAP_MSGS; - if (erts_system_monitor_long_gc != 0) { - get_now(&ms1, &s1, &us1); - } + (void) erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); + if (erts_system_monitor_long_gc != 0) + start_time = erts_get_monotonic_time(esdp); ERTS_CHK_OFFHEAP(p); @@ -449,11 +445,11 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) while (!done) { if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { DTRACE2(gc_major_start, pidbuf, need); - done = major_collection(p, need, objv, nobj, &reclaimed_now, off_heap_msgs); + done = major_collection(p, need, objv, nobj, &reclaimed_now); DTRACE2(gc_major_end, pidbuf, reclaimed_now); } else { DTRACE2(gc_minor_start, pidbuf, need); - done = minor_collection(p, need, objv, nobj, &reclaimed_now, off_heap_msgs); + done = minor_collection(p, need, objv, nobj, &reclaimed_now); DTRACE2(gc_minor_end, pidbuf, reclaimed_now); } } @@ -474,16 +470,14 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) } if (erts_system_monitor_long_gc != 0) { - Uint ms2, s2, us2; - Sint t; + ErtsMonotonicTime end_time; + Uint gc_time; if (erts_test_long_gc_sleep) while (0 != erts_milli_sleep(erts_test_long_gc_sleep)); - get_now(&ms2, &s2, &us2); - t = ms2 - ms1; - t = t*1000000 + s2 - s1; - t = t*1000 + ((Sint) (us2 - us1))/1000; - if (t > 0 && (Uint)t > erts_system_monitor_long_gc) { - monitor_long_gc(p, t); + end_time = erts_get_monotonic_time(esdp); + gc_time = (Uint) ERTS_MONOTONIC_TO_MSEC(end_time - start_time); + if (gc_time && gc_time > erts_system_monitor_long_gc) { + monitor_long_gc(p, gc_time); } } if (erts_system_monitor_large_heap != 0) { @@ -836,7 +830,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, } static int -minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int off_heap_msgs) +minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) { Uint mature = HIGH_WATER(p) - HEAP_START(p); @@ -875,22 +869,20 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int of Uint size_after; Uint need_after; Uint stack_size = STACK_SZ_ON_HEAP(p); - Uint fragments = MBUF_SIZE(p) + combined_message_size(p, off_heap_msgs); + Uint fragments = MBUF_SIZE(p) + combined_message_size(p); Uint size_before = fragments + (HEAP_TOP(p) - HEAP_START(p)); Uint new_sz = next_heap_size(p, HEAP_SIZE(p) + fragments, 0); do_minor(p, new_sz, objv, nobj); - if (!off_heap_msgs) { - /* - * Copy newly received message onto the end of the new heap. - */ - ErtsGcQuickSanityCheck(p); - for (msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) { - erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp); - ErtsGcQuickSanityCheck(p); - } + /* + * Copy newly received message onto the end of the new heap. + */ + ErtsGcQuickSanityCheck(p); + for (msgp = p->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached) { + erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp); + ErtsGcQuickSanityCheck(p); } } ErtsGcQuickSanityCheck(p); @@ -1216,7 +1208,7 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) */ static int -major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int off_heap_msgs) +major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) { Rootset rootset; Roots* roots; @@ -1229,7 +1221,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int of Uint oh_size = (char *) OLD_HTOP(p) - oh; Uint n; Uint new_sz; - Uint fragments = MBUF_SIZE(p) + combined_message_size(p, off_heap_msgs); + Uint fragments = MBUF_SIZE(p) + combined_message_size(p); size_before = fragments + (HEAP_TOP(p) - HEAP_START(p)); @@ -1439,7 +1431,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl, int of ErtsGcQuickSanityCheck(p); - if (!off_heap_msgs) { + { ErlMessage *msgp; /* * Copy newly received message onto the end of the new heap. @@ -1509,14 +1501,11 @@ adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int * mbuf list. */ static Uint -combined_message_size(Process* p, int off_heap_msgs) +combined_message_size(Process* p) { Uint sz; ErlMessage *msgp; - if (off_heap_msgs) - return 0; - for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) { if (msgp->data.attached) sz += erts_msg_attached_data_size(msgp); @@ -2665,7 +2654,7 @@ reply_gc_info(void *vgcirp) if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); if (erts_smp_atomic32_dec_read_nob(&gcirp->refc) == 0) gcireq_free(vgcirp); @@ -2689,7 +2678,7 @@ erts_gc_info_request(Process *c_p) erts_smp_atomic32_init_nob(&gcirp->refc, (erts_aint32_t) erts_no_schedulers); - erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + erts_proc_add_refc(c_p, (Sint) erts_no_schedulers); #ifdef ERTS_SMP if (erts_no_schedulers > 1) diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c new file mode 100644 index 0000000000..51cd843935 --- /dev/null +++ b/erts/emulator/beam/erl_hl_timer.c @@ -0,0 +1,2894 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: High level timers implementing BIF timers + * as well as process and port timers. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "bif.h" +#include "erl_bif_unique.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" +#include "erl_hl_timer.h" + +#define ERTS_TMR_CHECK_CANCEL_ON_CREATE 0 + +#if 0 +# define ERTS_HLT_HARD_DEBUG +#endif +#if 0 +# define ERTS_HLT_DEBUG +#endif + +#if defined(ERTS_HLT_HARD_DEBUG) || defined(DEBUG) +# if defined(ERTS_HLT_HARD_DEBUG) +# undef ERTS_RBT_HARD_DEBUG +# define ERTS_RBT_HARD_DEBUG 1 +# endif +# ifndef ERTS_HLT_DEBUG +# define ERTS_HLT_DEBUG 1 +# endif +#endif + +#undef ERTS_HLT_ASSERT +#if defined(ERTS_HLT_DEBUG) +# define ERTS_HLT_ASSERT(E) ERTS_ASSERT(E) +# undef ERTS_RBT_DEBUG +# define ERTS_RBT_DEBUG +#else +# define ERTS_HLT_ASSERT(E) ((void) 1) +#endif + +#if defined(ERTS_HLT_HARD_DEBUG) && defined(__GNUC__) +#warning "* * * * * * * * * * * * * * * * * *" +#warning "* ERTS_HLT_HARD_DEBUG IS ENABLED! *" +#warning "* * * * * * * * * * * * * * * * * *" +#endif + +#ifdef ERTS_HLT_HARD_DEBUG +# define ERTS_HLT_HDBG_CHK_SRV(SRV) hdbg_chk_srv((SRV)) +static void hdbg_chk_srv(ErtsHLTimerService *srv); +#else +# define ERTS_HLT_HDBG_CHK_SRV(SRV) ((void) 1) +#endif + +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + +#define ERTS_BIF_TIMER_SHORT_TIME 5000 + +#ifdef ERTS_SMP +# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore \ + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore) +#else +# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore +#endif + +/* Bit 0 to 9 contains scheduler id (see mask below) */ +#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 10) +#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 11) +#define ERTS_TMR_ROFLG_ABIF_TMR (((Uint32) 1) << 12) +#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 13) +#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 14) +#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 15) +#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 16) + +#define ERTS_TMR_ROFLG_SID_MASK \ + (ERTS_TMR_ROFLG_HLT - (Uint32) 1) + +#define ERTS_TMR_STATE_ACTIVE ((erts_aint32_t) 0) +#define ERTS_TMR_STATE_CANCELED ((erts_aint32_t) 1) +#define ERTS_TMR_STATE_TIMED_OUT ((erts_aint32_t) 2) + +typedef struct ErtsHLTimer_ ErtsHLTimer; + +#define ERTS_HLT_PFLG_RED (((UWord) 1) << 0) +#define ERTS_HLT_PFLG_SAME_TIME (((UWord) 1) << 1) + +#define ERTS_HLT_PFLGS_MASK \ + (ERTS_HLT_PFLG_RED|ERTS_HLT_PFLG_SAME_TIME) + +#define ERTS_HLT_PFIELD_NOT_IN_TABLE (~((UWord) 0)) + +typedef struct { + UWord parent; /* parent pointer and flags... */ + union { + struct { + ErtsHLTimer *right; + ErtsHLTimer *left; + } t; + struct { + ErtsHLTimer *prev; + ErtsHLTimer *next; + } l; + } u; + ErtsHLTimer *same_time; +} ErtsHLTimerTimeTree; + +typedef struct { + UWord parent; /* parent pointer and flags... */ + ErtsHLTimer *right; + ErtsHLTimer *left; +} ErtsHLTimerTree; + +typedef struct { + Uint32 roflgs; + erts_smp_atomic32_t refc; + union { + erts_atomic_t next; + } u; +} ErtsTmrHead; + +struct ErtsHLTimer_ { + ErtsTmrHead head; /* NEED to be first! */ + union { + ErtsThrPrgrLaterOp cleanup; + ErtsHLTimerTimeTree tree; + } time; + ErtsMonotonicTime timeout; + union { + Process *proc; + Port *port; + Eterm name; + } receiver; + +#ifdef ERTS_HLT_HARD_DEBUG + int pending_timeout; +#endif + + erts_smp_atomic32_t state; + + /* BIF timer only fields follow... */ + struct { + Uint32 refn[ERTS_REF_NUMBERS]; + ErtsHLTimerTree proc_tree; + ErtsHLTimerTree tree; + Eterm message; + ErlHeapFragment *bp; + } btm; + struct { + Eterm accessor; + ErtsHLTimerTree tree; + } abtm; +}; + +#define ERTS_HL_PTIMER_SIZE offsetof(ErtsHLTimer, btm) +#define ERTS_BIF_TIMER_SIZE offsetof(ErtsHLTimer, abtm) +#define ERTS_ABIF_TIMER_SIZE sizeof(ErtsHLTimer) + +typedef struct { + ErtsTmrHead head; /* NEED to be first! */ + void *p; + ErtsTWheelTimer tw_tmr; +} ErtsTWTimer; + +typedef union { + ErtsTmrHead head; + ErtsHLTimer hlt; + ErtsTWTimer twt; +} ErtsTimer; + +#ifdef SMALL_MEMORY +#define BIF_TIMER_PREALC_SZ 10 +#define PTIMER_PREALC_SZ 10 +#else +#define BIF_TIMER_PREALC_SZ 100 +#define PTIMER_PREALC_SZ 100 +#endif + +ERTS_SCHED_PREF_PALLOC_IMPL(bif_timer_pre, + ErtsHLTimer, + BIF_TIMER_PREALC_SZ) + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(tw_timer, + ErtsTWTimer, + PTIMER_PREALC_SZ, + ERTS_ALC_T_LL_PTIMER) + +#ifdef ERTS_HLT_DEBUG +#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 5 +#else +#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 100 +#endif +#define ERTS_TMR_CANCELED_TIMER_LIMIT 100 +#define ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT 5 + +#define ERTS_TMR_TIMEOUT_YIELD_STATE_T same_time_list_yield_state_t +#define ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER {NULL, {0}} +typedef struct { + int dummy; +} ERTS_TMR_TIMEOUT_YIELD_STATE_T; + +typedef struct { + ErtsTmrHead marker; + erts_atomic_t last; +} ErtsHLTCncldTmrQTail; + +#ifdef ERTS_SMP + +typedef struct { + /* + * This structure needs to be cache line aligned for best + * performance. + */ + union { + /* + * Modified by threads returning canceled + * timers to this timer service. + */ + ErtsHLTCncldTmrQTail data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE( + sizeof(ErtsHLTCncldTmrQTail))]; + } tail; + /* + * Everything below this point is *only* accessed by the + * thread managing this timer service. + */ + struct { + ErtsTimer *first; + ErtsTimer *unref_end; + struct { + ErtsThrPrgrVal thr_progress; + int thr_progress_reached; + ErtsTimer *unref_end; + } next; + int used_marker; + } head; +} ErtsHLTCncldTmrQ; + +#endif /* ERTS_SMP */ + +typedef struct { + ErtsHLTimer *root; + ERTS_TMR_TIMEOUT_YIELD_STATE_T state; +} ErtsYieldingTimeoutState; + +struct ErtsHLTimerService_ { +#ifdef ERTS_SMP + ErtsHLTCncldTmrQ canceled_queue; +#endif + ErtsHLTimer *time_tree; + ErtsHLTimer *btm_tree; + ErtsHLTimer *next_timeout; + ErtsYieldingTimeoutState yield; + ErtsTWheelTimer service_timer; +}; + +static ERTS_INLINE int +refn_is_lt(Uint32 *x, Uint32 *y) +{ + /* !0 if x < y */ + if (x[2] < y[2]) + return 1; + if (x[2] != y[2]) + return 0; + if (x[1] < y[1]) + return 1; + if (x[1] != y[1]) + return 0; + return x[0] < y[0]; +} + +#define ERTS_RBT_PREFIX time +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T ErtsMonotonicTime +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->time.tree.parent = (UWord) NULL; \ + (T)->time.tree.u.t.right = NULL; \ + (T)->time.tree.u.t.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->time.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->time.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->time.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->time.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->time.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->time.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->time.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->time.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->time.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->time.tree.u.t.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->time.tree.u.t.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->time.tree.u.t.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->time.tree.u.t.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->timeout) +#define ERTS_RBT_IS_LT(KX, KY) ((KX) < (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) ((KX) == (KY)) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_SMALLEST +#define ERTS_RBT_WANT_LOOKUP_INSERT +#define ERTS_RBT_WANT_REPLACE +#ifdef ERTS_HLT_HARD_DEBUG +# define ERTS_RBT_WANT_FOREACH +# define ERTS_RBT_WANT_LOOKUP +#endif +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +/* Use circular list for timers at same time */ + +static ERTS_INLINE void +same_time_list_insert(ErtsHLTimer **root, ErtsHLTimer *tmr) +{ + ErtsHLTimer *first = *root; + if (!first) { + ERTS_HLT_ASSERT((((UWord) root) & ERTS_HLT_PFLG_SAME_TIME) == 0); + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + tmr->time.tree.u.l.next = tmr; + tmr->time.tree.u.l.prev = tmr; + *root = tmr; + } + else { + tmr->time.tree.parent = ERTS_HLT_PFLG_SAME_TIME; + tmr->time.tree.u.l.next = first; + tmr->time.tree.u.l.prev = first->time.tree.u.l.prev; + first->time.tree.u.l.prev = tmr; + tmr->time.tree.u.l.prev->time.tree.u.l.next = tmr; + } +} + +static ERTS_INLINE void +same_time_list_delete(ErtsHLTimer *tmr) +{ + ErtsHLTimer **root, *next; + + root = (ErtsHLTimer **) (tmr->time.tree.parent & ~ERTS_HLT_PFLG_SAME_TIME); + next = tmr->time.tree.u.l.next; + + ERTS_HLT_ASSERT((tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)) + || (tmr->time.tree.parent + == ERTS_HLT_PFLG_SAME_TIME)); + + if (next == tmr) { + ERTS_HLT_ASSERT(root && *root == tmr); + ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev == tmr); + *root = NULL; + } + else { + if (root) { + ERTS_HLT_ASSERT(*root == tmr); + *root = next; + next->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + } + tmr->time.tree.u.l.next->time.tree.u.l.prev = tmr->time.tree.u.l.prev; + tmr->time.tree.u.l.prev->time.tree.u.l.next = next; + } +} + +static ERTS_INLINE void +same_time_list_new_root(ErtsHLTimer **root) +{ + ErtsHLTimer *tmr = *root; + if (tmr) { + ERTS_HLT_ASSERT(root); + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + } +} + +static ERTS_INLINE int +same_time_list_foreach_destroy_yielding(ErtsHLTimer **root, + void (*op)(ErtsHLTimer *, void *), + void *arg, + ERTS_TMR_TIMEOUT_YIELD_STATE_T *ys, + Sint ylimit) +{ + Sint ycnt = ylimit; + ErtsHLTimer *end, *tmr = *root; + if (!tmr) + return 0; + + ERTS_HLT_ASSERT(tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)); + + end = tmr->time.tree.u.l.prev; + end->time.tree.u.l.next = NULL; + + while (1) { + ErtsHLTimer *op_tmr = tmr; + + ERTS_HLT_ASSERT((tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)) + || (tmr->time.tree.parent + == ERTS_HLT_PFLG_SAME_TIME)); + + tmr = tmr->time.tree.u.l.next; + (*op)(op_tmr, arg); + if (!tmr) { + *root = NULL; + return 0; + } + if (--ycnt <= 0) { + /* Make new circle of timers left to process... */ + *root = tmr; + end->time.tree.u.l.next = tmr; + tmr->time.tree.u.l.prev = end; + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + return 1; + } + } +} + +#ifdef ERTS_HLT_HARD_DEBUG + +static ERTS_INLINE void +same_time_list_foreach(ErtsHLTimer *root, + void (*op)(ErtsHLTimer *, void *), + void *arg) +{ + if (root) { + ErtsHLTimer *tmr = root; + do { + (*op)(tmr, arg); + tmr = tmr->time.tree.u.l.next; + } while (root != tmr); + } +} + +static ERTS_INLINE ErtsHLTimer * +same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) +{ + if (root) { + ErtsHLTimer *tmr = root; + do { + if (tmr == x) + return tmr; + tmr = tmr->time.tree.u.l.next; + } while (root != tmr); + } + return NULL; +} + +#endif /* ERTS_HLT_HARD_DEBUG */ + +#define ERTS_RBT_PREFIX btm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->btm.tree.parent = (UWord) NULL; \ + (T)->btm.tree.right = NULL; \ + (T)->btm.tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->btm.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->btm.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->btm.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->btm.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->btm.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->btm.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->btm.tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#define ERTS_RBT_PREFIX proc_btm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->btm.proc_tree.parent = (UWord) NULL; \ + (T)->btm.proc_tree.right = NULL; \ + (T)->btm.proc_tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->btm.proc_tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->btm.proc_tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->btm.proc_tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->btm.proc_tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->btm.proc_tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.proc_tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->btm.proc_tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.proc_tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.proc_tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->btm.proc_tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.proc_tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#define ERTS_RBT_PREFIX abtm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->abtm.tree.parent = (UWord) NULL; \ + (T)->abtm.tree.right = NULL; \ + (T)->abtm.tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->abtm.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->abtm.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->abtm.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->abtm.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->abtm.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->abtm.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->abtm.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->abtm.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->abtm.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->abtm.tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->abtm.tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->abtm.tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->abtm.tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#ifdef ERTS_SMP +static void init_canceled_queue(ErtsHLTCncldTmrQ *cq); +#endif + +void +erts_hl_timer_init(void) +{ + init_tw_timer_alloc(); + init_bif_timer_pre_alloc(); +} + +ErtsHLTimerService * +erts_create_timer_service(void) +{ + ErtsYieldingTimeoutState init_yield = ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER; + ErtsHLTimerService *srv; + + srv = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_SERVICE, + sizeof(ErtsHLTimerService)); + srv->time_tree = NULL; + srv->btm_tree = NULL; + srv->next_timeout = NULL; + srv->yield = init_yield; + erts_twheel_init_timer(&srv->service_timer); + +#ifdef ERTS_SMP + init_canceled_queue(&srv->canceled_queue); +#endif + + return srv; +} + +size_t +erts_timer_type_size(ErtsAlcType_t type) +{ + switch (type) { + case ERTS_ALC_T_LL_PTIMER: return sizeof(ErtsTWTimer); + case ERTS_ALC_T_HL_PTIMER: return ERTS_HL_PTIMER_SIZE; + case ERTS_ALC_T_BIF_TIMER: return ERTS_BIF_TIMER_SIZE; + case ERTS_ALC_T_ABIF_TIMER: return ERTS_ABIF_TIMER_SIZE; + default: ERTS_INTERNAL_ERROR("Unknown type"); + } + return 0; +} + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime msec) +{ + ErtsMonotonicTime timeout_pos; + if (msec <= 0) + return ERTS_MONOTONIC_TO_CLKTCKS(now); + timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(now-1); + timeout_pos += ERTS_MSEC_TO_CLKTCKS(msec) + 1; + return timeout_pos; +} + +static ERTS_INLINE Sint64 +get_time_left(ErtsSchedulerData *esdp, ErtsMonotonicTime timeout_pos) +{ + ErtsMonotonicTime now = erts_get_monotonic_time(esdp); + + now = ERTS_MONOTONIC_TO_CLKTCKS(now-1)+1; + if (timeout_pos <= now) + return (Sint64) 0; + return (Sint64) ERTS_CLKTCKS_TO_MSEC(timeout_pos - now); +} + +static ERTS_INLINE int +proc_timeout_common(Process *proc, void *tmr) +{ + if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&proc->common.timer, + ERTS_PTMR_TIMEDOUT, + (erts_aint_t) tmr)) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&proc->state); + if (!(state & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_EXITING))) + erts_schedule_process(proc, state, 0); + return 1; + } + return 0; +} + +static ERTS_INLINE int +port_timeout_common(Port *port, void *tmr) +{ + if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&port->common.timer, + ERTS_PTMR_TIMEDOUT, + (erts_aint_t) tmr)) { + erts_port_task_schedule(port->common.id, + &port->timeout_task, + ERTS_PORT_TASK_TIMEOUT); + return 1; + } + return 0; +} + +/* + * Basic timer wheel timer stuff + */ + +static void +scheduled_tw_timer_destroy(void *vtmr) +{ + tw_timer_free((ErtsTWTimer *) vtmr); +} + +static void +schedule_tw_timer_destroy(ErtsTWTimer *tmr) +{ + /* + * Reference to process/port can be + * dropped at once... + */ + if (tmr->head.roflgs & ERTS_TMR_ROFLG_PROC) + erts_proc_dec_refc((Process *) tmr->p); + else + erts_port_dec_refc((Port *) tmr->p); + + erts_schedule_thr_prgr_later_cleanup_op( + scheduled_tw_timer_destroy, + (void *) tmr, + &tmr->tw_tmr.u.cleanup, + sizeof(ErtsTWTimer)); +} + +static ERTS_INLINE void +tw_timer_dec_refc(ErtsTWTimer *tmr) +{ + if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) { + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + schedule_tw_timer_destroy(tmr); + } +} + +static void +tw_proc_timeout(void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + Process *proc = (Process *) twtp->p; + if (proc_timeout_common(proc, vtwtp)) + tw_timer_dec_refc(twtp); + tw_timer_dec_refc(twtp); +} + +static void +tw_port_timeout(void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + Port *port = (Port *) twtp->p; + if (port_timeout_common(port, vtwtp)) + tw_timer_dec_refc(twtp); + tw_timer_dec_refc(twtp); +} + +static void +tw_ptimer_cancel(void *vtwtp) +{ + tw_timer_dec_refc((ErtsTWTimer *) vtwtp); +} + +static void +cancel_tw_timer(ErtsSchedulerData *esdp, ErtsTWTimer *tmr) +{ + ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK) + == (Uint32) esdp->no); + erts_twheel_cancel_timer(esdp->timer_wheel, &tmr->tw_tmr); +} + +static ErtsTWTimer * +create_tw_timer(ErtsSchedulerData *esdp, + void *p, int is_proc, + ErtsMonotonicTime timeout_pos) +{ + ErtsTWTimer *tmr; + void (*timeout_func)(void *); + + tmr = tw_timer_alloc(); + erts_twheel_init_timer(&tmr->tw_tmr); + + tmr->head.roflgs = (Uint32) esdp->no; + ERTS_HLT_ASSERT((tmr->head.roflgs + & ~ERTS_TMR_ROFLG_SID_MASK) == 0); + tmr->p = p; + if (is_proc) { + tmr->head.roflgs |= ERTS_TMR_ROFLG_PROC; + timeout_func = tw_proc_timeout; + erts_proc_inc_refc((Process *) p); + } + else { + tmr->head.roflgs |= ERTS_TMR_ROFLG_PORT; + timeout_func = tw_port_timeout; + erts_port_inc_refc((Port *) p); + } + + erts_smp_atomic32_init_nob(&tmr->head.refc, 2); + + erts_twheel_set_timer(esdp->timer_wheel, + &tmr->tw_tmr, + timeout_func, + tw_ptimer_cancel, + tmr, + timeout_pos); + + return tmr; +} + +/* + * Basic high level timer stuff + */ + +static ERTS_INLINE void +hl_timer_destroy(ErtsHLTimer *tmr) +{ + Uint32 roflgs = tmr->head.roflgs; + if (!(roflgs & ERTS_TMR_ROFLG_BIF_TMR)) + erts_free(ERTS_ALC_T_HL_PTIMER, tmr); + else { + if (roflgs & ERTS_TMR_ROFLG_PRE_ALC) + bif_timer_pre_free(tmr); + else if (roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + erts_free(ERTS_ALC_T_ABIF_TIMER, tmr); + else + erts_free(ERTS_ALC_T_BIF_TIMER, tmr); + } +} + +static void +scheduled_hl_timer_destroy(void *vtmr) +{ + hl_timer_destroy((ErtsHLTimer *) vtmr); +} + +static void +schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs) +{ + UWord size; + + /* + * Reference to process/port can be dropped + * at once... + */ + + ERTS_HLT_ASSERT(erts_smp_atomic32_read_nob(&tmr->head.refc) == 0); + + if (roflgs & ERTS_TMR_ROFLG_REG_NAME) { + ERTS_HLT_ASSERT(is_atom(tmr->receiver.name)); + } + else if (roflgs & ERTS_TMR_ROFLG_PROC) { + ERTS_HLT_ASSERT(tmr->receiver.proc); + erts_proc_dec_refc(tmr->receiver.proc); + } + else if (roflgs & ERTS_TMR_ROFLG_PORT) { + ERTS_HLT_ASSERT(tmr->receiver.port); + erts_port_dec_refc(tmr->receiver.port); + } + + if (!(roflgs & ERTS_TMR_ROFLG_BIF_TMR)) + size = ERTS_HL_PTIMER_SIZE; + else { + /* + * Message buffer can be dropped at + * once... + */ + size = sizeof(ErtsHLTimer); + } + + erts_schedule_thr_prgr_later_cleanup_op( + scheduled_hl_timer_destroy, tmr, + &tmr->time.cleanup, size); +} + +static ERTS_INLINE void +hl_timer_pre_dec_refc(ErtsHLTimer *tmr) +{ +#ifdef ERTS_HLT_DEBUG + erts_aint_t refc; + refc = erts_smp_atomic32_dec_read_nob(&tmr->head.refc); + ERTS_HLT_ASSERT(refc > 0); +#else + erts_smp_atomic32_dec_nob(&tmr->head.refc); +#endif +} + +static ERTS_INLINE void +hl_timer_dec_refc(ErtsHLTimer *tmr, Uint32 roflgs) +{ + if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) { + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + schedule_hl_timer_destroy(tmr, roflgs); + } +} + +static void hlt_service_timeout(void *vesdp); +#ifdef ERTS_SMP +static void handle_canceled_queue(ErtsSchedulerData *esdp, + ErtsHLTCncldTmrQ *cq, + int use_limit, + int ops_limit, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work); +#endif + +static ERTS_INLINE void +check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv) +{ +#if defined(ERTS_SMP) && ERTS_TMR_CHECK_CANCEL_ON_CREATE + ErtsHLTCncldTmrQ *cq = &srv->canceled_queue; + if (cq->head.first != cq->head.unref_end) + handle_canceled_queue(esdp, cq, 1, + ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT, + NULL, NULL, NULL); +#endif +} + +static void +hlt_delete_abtm(ErtsHLTimer *tmr) +{ + Process *proc; + + ERTS_HLT_ASSERT(tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR); + + proc = erts_proc_lookup(tmr->abtm.accessor); + + if (proc) { + int deref = 0; + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM); + if (tmr->abtm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + abtm_rbt_delete(&proc->accessor_bif_timers, tmr); + deref = 1; + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + if (deref) + hl_timer_pre_dec_refc(tmr); + } +} + +static ErtsHLTimer * +create_hl_timer(ErtsSchedulerData *esdp, + ErtsMonotonicTime timeout_pos, + int short_time, int is_bif_tmr, + void *rcvrp, Eterm rcvr, Eterm acsr, + Eterm msg, Uint32 *refn) +{ + ErtsHLTimerService *srv = esdp->timer_service; + ErtsHLTimer *tmr, *st_tmr; + erts_aint32_t refc; + Uint32 roflgs; + int is_abif_tmr = is_bif_tmr && is_value(acsr) && acsr != rcvr; + + check_canceled_queue(esdp, srv); + + ERTS_HLT_ASSERT((esdp->no & ~ERTS_TMR_ROFLG_SID_MASK) == 0); + + roflgs = ((Uint32) esdp->no) | ERTS_TMR_ROFLG_HLT; + + if (!is_bif_tmr) + tmr = erts_alloc(ERTS_ALC_T_HL_PTIMER, + ERTS_HL_PTIMER_SIZE); + else if (short_time) { + tmr = bif_timer_pre_alloc(); + if (!tmr) + goto alloc_bif_timer; + roflgs |= ERTS_TMR_ROFLG_PRE_ALC; + } + else { + alloc_bif_timer: + if (is_abif_tmr) + tmr = erts_alloc(ERTS_ALC_T_ABIF_TIMER, + ERTS_ABIF_TIMER_SIZE); + else + tmr = erts_alloc(ERTS_ALC_T_BIF_TIMER, + ERTS_BIF_TIMER_SIZE); + } + + tmr->timeout = timeout_pos; + + if (!is_bif_tmr) { + if (is_internal_pid(rcvr)) { + erts_proc_inc_refc((Process *) rcvrp); + tmr->receiver.proc = (Process *) rcvrp; + roflgs |= ERTS_TMR_ROFLG_PROC; + } + else { + erts_port_inc_refc((Port *) rcvrp); + ERTS_HLT_ASSERT(is_internal_port(rcvr)); + tmr->receiver.port = (Port *) rcvrp; + roflgs |= ERTS_TMR_ROFLG_PORT; + } + refc = 2; + } + else { + Uint hsz; + + roflgs |= ERTS_TMR_ROFLG_BIF_TMR; + if (is_internal_pid(rcvr)) { + roflgs |= ERTS_TMR_ROFLG_PROC; + tmr->receiver.proc = (Process *) rcvrp; + refc = 2; + } + else { + ERTS_HLT_ASSERT(is_atom(rcvr)); + roflgs |= ERTS_TMR_ROFLG_REG_NAME; + tmr->receiver.name = rcvr; + refc = 1; + } + + hsz = is_immed(msg) ? ((Uint) 0) : size_object(msg); + if (!hsz) { + tmr->btm.message = msg; + tmr->btm.bp = NULL; + } + else { + ErlHeapFragment *bp = new_message_buffer(hsz); + Eterm *hp = bp->mem; + tmr->btm.message = copy_struct(msg, hsz, &hp, &bp->off_heap); + tmr->btm.bp = bp; + } + tmr->btm.refn[0] = refn[0]; + tmr->btm.refn[1] = refn[1]; + tmr->btm.refn[2] = refn[2]; + + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + if (is_abif_tmr) { + Process *aproc; + roflgs |= ERTS_TMR_ROFLG_ABIF_TMR; + tmr->abtm.accessor = acsr; + aproc = erts_proc_lookup(acsr); + if (!aproc) + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + else { + refc++; + erts_smp_proc_lock(aproc, ERTS_PROC_LOCK_BTM); + abtm_rbt_insert(&aproc->accessor_bif_timers, tmr); + erts_smp_proc_unlock(aproc, ERTS_PROC_LOCK_BTM); + } + } + } + + tmr->head.roflgs = roflgs; + erts_smp_atomic32_init_nob(&tmr->head.refc, refc); + erts_smp_atomic32_init_nob(&tmr->state, ERTS_TMR_STATE_ACTIVE); + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (!srv->next_timeout + || tmr->timeout < srv->next_timeout->timeout) { + if (srv->next_timeout) + erts_twheel_cancel_timer(esdp->timer_wheel, + &srv->service_timer); + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + (void *) esdp, + tmr->timeout); + srv->next_timeout = tmr; + } + + st_tmr = time_rbt_lookup_insert(&srv->time_tree, tmr); + tmr->time.tree.same_time = st_tmr; + if (st_tmr) + same_time_list_insert(&st_tmr->time.tree.same_time, tmr); + + if (is_bif_tmr) + btm_rbt_insert(&srv->btm_tree, tmr); + +#ifdef ERTS_HLT_HARD_DEBUG + tmr->pending_timeout = 0; +#endif + + ERTS_HLT_HDBG_CHK_SRV(srv); + + return tmr; +} + +static ERTS_INLINE void +hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) +{ + ErtsProcLocks proc_locks = ERTS_PROC_LOCKS_MSG_SEND; + Process *proc; + int queued_message = 0; + int dec_refc = 0; + Uint32 is_reg_name = (roflgs & ERTS_TMR_ROFLG_REG_NAME); + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_BIF_TMR); + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + hlt_delete_abtm(tmr); + + if (is_reg_name) { + Eterm pid; + ERTS_HLT_ASSERT(is_atom(tmr->receiver.name)); + pid = erts_whereis_name_to_id(NULL, tmr->receiver.name); + proc = erts_proc_lookup(pid); + } + else { + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PROC); + ERTS_HLT_ASSERT(tmr->receiver.proc); + + proc = tmr->receiver.proc; + proc_locks |= ERTS_PROC_LOCK_BTM; + } + if (proc) { + erts_smp_proc_lock(proc, proc_locks); + /* + * If process is exiting, let it clean up + * the btm tree by itself (it may be in + * the middle of tree destruction). + */ + if (!ERTS_PROC_IS_EXITING(proc)) { + erts_queue_message(proc, &proc_locks, tmr->btm.bp, + tmr->btm.message, NIL); + erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND); + queued_message = 1; + proc_locks &= ~ERTS_PROC_LOCKS_MSG_SEND; + tmr->btm.bp = NULL; + if (tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + proc_btm_rbt_delete(&proc->bif_timers, tmr); + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + dec_refc = 1; + } + } + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + if (dec_refc) + hl_timer_pre_dec_refc(tmr); + } + if (!queued_message && tmr->btm.bp) + free_message_buffer(tmr->btm.bp); +} + +static ERTS_INLINE void +hlt_proc_timeout(ErtsHLTimer *tmr) +{ + if (proc_timeout_common(tmr->receiver.proc, (void *) tmr)) + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +static ERTS_INLINE void +hlt_port_timeout(ErtsHLTimer *tmr) +{ + if (port_timeout_common(tmr->receiver.port, (void *) tmr)) + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +static void hlt_timeout(ErtsHLTimer *tmr, void *vsrv) +{ + ErtsHLTimerService *srv = (ErtsHLTimerService *) vsrv; + Uint32 roflgs; + erts_aint32_t state; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + roflgs = tmr->head.roflgs; + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_HLT); + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_TIMED_OUT, + ERTS_TMR_STATE_ACTIVE); + + ERTS_HLT_ASSERT(state == ERTS_TMR_STATE_CANCELED + || state == ERTS_TMR_STATE_ACTIVE); + + if (state == ERTS_TMR_STATE_ACTIVE) { + + if (roflgs & ERTS_TMR_ROFLG_BIF_TMR) + hlt_bif_timer_timeout(tmr, roflgs); + else if (roflgs & ERTS_TMR_ROFLG_PROC) + hlt_proc_timeout(tmr); + else { + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PORT); + hlt_port_timeout(tmr); + } + } + + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + if ((roflgs & ERTS_TMR_ROFLG_BIF_TMR) + && tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + btm_rbt_delete(&srv->btm_tree, tmr); + tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + + ERTS_HLT_HDBG_CHK_SRV(srv); + + hl_timer_dec_refc(tmr, roflgs); +} + +#ifdef ERTS_HLT_HARD_DEBUG +static void +set_pending_timeout(ErtsHLTimer *tmr, void *unused) +{ + tmr->pending_timeout = -1; +} +#endif + +static void +hlt_service_timeout(void *vesdp) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ErtsHLTimerService *srv = esdp->timer_service; + ErtsHLTimer *tmr = srv->next_timeout; + int yield; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + + ERTS_HLT_ASSERT(!srv->yield.root || srv->yield.root == tmr); + ERTS_HLT_ASSERT(tmr); + ERTS_HLT_ASSERT(tmr->timeout <= erts_get_monotonic_time(esdp)); + + if (!srv->yield.root) { + ERTS_HLT_ASSERT(tmr->time.tree.parent + != ERTS_HLT_PFIELD_NOT_IN_TABLE); + time_rbt_delete(&srv->time_tree, tmr); + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; +#ifdef ERTS_HLT_HARD_DEBUG + tmr->pending_timeout = 1; + if (tmr->time.tree.same_time) + same_time_list_foreach(tmr->time.tree.same_time, set_pending_timeout, NULL); +#endif + } + + if (!tmr->time.tree.same_time && !srv->yield.root) + yield = 0; + else { + yield = same_time_list_foreach_destroy_yielding( + &tmr->time.tree.same_time, hlt_timeout, (void *) srv, + &srv->yield.state, ERTS_TMR_TIMEOUT_YIELD_LIMIT); + } + + if (yield) + srv->yield.root = tmr; + else { + srv->yield.root = NULL; + hlt_timeout(tmr, (void *) srv); + + tmr = time_rbt_smallest(srv->time_tree); + srv->next_timeout = tmr; + } + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (tmr) + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + vesdp, + tmr->timeout); +} + +static void +hlt_delete_timer(ErtsSchedulerData *esdp, ErtsHLTimer *tmr) +{ + ErtsHLTimerService *srv = esdp->timer_service; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR) { + + if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + btm_rbt_delete(&srv->btm_tree, tmr); + tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + hlt_delete_abtm(tmr); + } + + if (tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE) { + /* Already removed... */ + ERTS_HLT_HDBG_CHK_SRV(srv); + return; + } + + if (tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) { + same_time_list_delete(tmr); + } + else if (tmr->time.tree.same_time) { + ErtsHLTimer *st_container; + + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + st_container = tmr->time.tree.same_time->time.tree.u.l.prev; + + ERTS_HLT_ASSERT(st_container); + ERTS_HLT_ASSERT(st_container->time.tree.parent + & ERTS_HLT_PFLG_SAME_TIME); + ERTS_HLT_ASSERT(tmr->timeout == st_container->timeout); + + same_time_list_delete(st_container); + st_container->time.tree.same_time = tmr->time.tree.same_time; + same_time_list_new_root(&st_container->time.tree.same_time); + + time_rbt_replace(&srv->time_tree, tmr, st_container); + ERTS_HLT_ASSERT((st_container->time.tree.parent + & ERTS_HLT_PFLG_SAME_TIME) == 0); + + if (srv->next_timeout == tmr) + srv->next_timeout = st_container; + } + else { + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + time_rbt_delete(&srv->time_tree, tmr); + if (tmr == srv->next_timeout) { + ErtsHLTimer *smlst; + erts_twheel_cancel_timer(esdp->timer_wheel, + &srv->service_timer); + smlst = time_rbt_smallest(srv->time_tree); + srv->next_timeout = smlst; + if (smlst) { + ERTS_HLT_ASSERT(smlst->timeout > tmr->timeout); + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + (void *) esdp, + smlst->timeout); + } + } + } + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + + hl_timer_dec_refc(tmr, tmr->head.roflgs); + + ERTS_HLT_HDBG_CHK_SRV(srv); +} + +/* + * Pass canceled timers back to originating scheduler + */ + +static ERTS_INLINE void +cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp, + ErtsTimer *tmr) +{ + Uint32 roflgs = tmr->head.roflgs; + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK) + == (Uint32) esdp->no); + if (roflgs & ERTS_TMR_ROFLG_HLT) { + hlt_delete_timer(esdp, &tmr->hlt); + hl_timer_dec_refc(&tmr->hlt, roflgs); + } + else { + cancel_tw_timer(esdp, &tmr->twt); + tw_timer_dec_refc(&tmr->twt); + } +} + +#ifdef ERTS_SMP + +static void +init_canceled_queue(ErtsHLTCncldTmrQ *cq) +{ + erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL); + erts_atomic_init_nob(&cq->tail.data.last, + (erts_aint_t) &cq->tail.data.marker); + cq->head.first = (ErtsTimer *) &cq->tail.data.marker; + cq->head.unref_end = (ErtsTimer *) &cq->tail.data.marker; + cq->head.next.thr_progress = erts_thr_progress_current(); + cq->head.next.thr_progress_reached = 1; + cq->head.next.unref_end = (ErtsTimer *) &cq->tail.data.marker; + cq->head.used_marker = 1; +} + +static ERTS_INLINE int +cq_enqueue(ErtsHLTCncldTmrQ *cq, ErtsTimer *tmr, int cinit) +{ + erts_aint_t itmp; + ErtsTimer *enq, *this = tmr; + + erts_atomic_init_nob(&this->head.u.next, ERTS_AINT_NULL); + /* Enqueue at end of list... */ + + enq = (ErtsTimer *) erts_atomic_read_nob(&cq->tail.data.last); + itmp = erts_atomic_cmpxchg_relb(&enq->head.u.next, + (erts_aint_t) this, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) { + /* We are required to move last pointer */ +#ifdef DEBUG + ASSERT(ERTS_AINT_NULL == erts_atomic_read_nob(&this->head.u.next)); + ASSERT(((erts_aint_t) enq) + == erts_atomic_xchg_relb(&cq->tail.data.last, + (erts_aint_t) this)); +#else + erts_atomic_set_relb(&cq->tail.data.last, (erts_aint_t) this); +#endif + return 1; + } + else { + /* + * We *need* to insert element somewhere in between the + * last element we read earlier and the actual last element. + */ + int i = cinit; + + while (1) { + erts_aint_t itmp2; + erts_atomic_set_nob(&this->head.u.next, itmp); + itmp2 = erts_atomic_cmpxchg_relb(&enq->head.u.next, + (erts_aint_t) this, + itmp); + if (itmp == itmp2) + return 0; /* inserted this */ + if ((i & 1) == 0) + itmp = itmp2; + else { + enq = (ErtsTimer *) itmp2; + itmp = erts_atomic_read_acqb(&enq->head.u.next); + ASSERT(itmp != ERTS_AINT_NULL); + } + i++; + } + } +} + +static ERTS_INLINE erts_aint_t +check_insert_marker(ErtsHLTCncldTmrQ *cq, erts_aint_t ilast) +{ + if (!cq->head.used_marker + && cq->head.unref_end == (ErtsTimer *) ilast) { + erts_aint_t itmp; + ErtsTimer *last = (ErtsTimer *) ilast; + + erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL); + itmp = erts_atomic_cmpxchg_relb(&last->head.u.next, + (erts_aint_t) &cq->tail.data.marker, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) { + ilast = (erts_aint_t) &cq->tail.data.marker; + cq->head.used_marker = !0; + erts_atomic_set_relb(&cq->tail.data.last, ilast); + } + } + return ilast; +} + +static ERTS_INLINE ErtsTimer * +cq_dequeue(ErtsHLTCncldTmrQ *cq) +{ + ErtsTimer *tmr; + + if (cq->head.first == cq->head.unref_end) + return NULL; + + tmr = cq->head.first; + if (tmr == (ErtsTimer *) &cq->tail.data.marker) { + ASSERT(cq->head.used_marker); + cq->head.used_marker = 0; + tmr = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next); + if (tmr == cq->head.unref_end) { + cq->head.first = tmr; + return NULL; + } + } + + cq->head.first = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next); + + ASSERT(cq->head.first); + + return tmr; +} + +static int +cq_check_incoming(ErtsSchedulerData *esdp, ErtsHLTCncldTmrQ *cq) +{ + erts_aint_t ilast = erts_atomic_read_nob(&cq->tail.data.last); + if (((ErtsTimer *) ilast) == (ErtsTimer *) &cq->tail.data.marker + && cq->head.first == (ErtsTimer *) &cq->tail.data.marker) { + /* Nothing more to do... */ + return 0; + } + + if (cq->head.next.thr_progress_reached + || erts_thr_progress_has_reached(cq->head.next.thr_progress)) { + cq->head.next.thr_progress_reached = 1; + /* Move unreferenced end pointer forward... */ + + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + + cq->head.unref_end = cq->head.next.unref_end; + + ilast = check_insert_marker(cq, ilast); + + if (cq->head.unref_end != (ErtsTimer *) ilast) { + cq->head.next.unref_end = (ErtsTimer *) ilast; + cq->head.next.thr_progress = erts_thr_progress_later(esdp); + cq->head.next.thr_progress_reached = 0; + } + } + return 1; +} + +static ERTS_INLINE void +store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsHLTCncldTmrQ *cq) +{ + if (!cq->head.next.thr_progress_reached + && (*prev_val == ERTS_THR_PRGR_INVALID + || erts_thr_progress_cmp(cq->head.next.thr_progress, + *prev_val) < 0)) { + *prev_val = cq->head.next.thr_progress; + } +} + +static void +handle_canceled_queue(ErtsSchedulerData *esdp, + ErtsHLTCncldTmrQ *cq, + int use_limit, + int ops_limit, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work) +{ + int need_thr_prgr = 0; + int need_mr_wrk = 0; + int have_checked_incoming = 0; + int ops = 0; + + ERTS_HLT_ASSERT(cq == &esdp->timer_service->canceled_queue); + + while (1) { + ErtsTimer *tmr = cq_dequeue(cq); + + if (tmr) + cleanup_sched_local_canceled_timer(esdp, tmr); + else { + if (have_checked_incoming) + break; + need_thr_prgr = cq_check_incoming(esdp, cq); + if (need_thr_progress) { + *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, cq); + } + have_checked_incoming = 1; + continue; + } + + if (use_limit && ++ops >= ops_limit) { + if (cq->head.first != cq->head.unref_end) { + need_mr_wrk = 1; + if (need_more_work) + *need_more_work |= 1; + } + break; + } + } + + if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) { + need_thr_prgr = cq_check_incoming(esdp, cq); + *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, cq); + } +} + +void +erts_handle_canceled_timers(void *vesdp, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + + handle_canceled_queue(esdp, &esdp->timer_service->canceled_queue, + 1, ERTS_TMR_CANCELED_TIMER_LIMIT, + need_thr_progress, thr_prgr_p, + need_more_work); +} + +#endif /* ERTS_SMP */ + +static void +queue_canceled_timer(ErtsSchedulerData *esdp, int rsched_id, ErtsTimer *tmr) +{ +#ifdef ERTS_SMP + ErtsHLTCncldTmrQ *cq; + cq = &ERTS_SCHEDULER_IX(rsched_id-1)->timer_service->canceled_queue; + if (cq_enqueue(cq, tmr, rsched_id - (int) esdp->no)) + erts_notify_canceled_timer(esdp, rsched_id); +#else + ERTS_INTERNAL_ERROR("Unexpected enqueue of canceled timer"); +#endif +} + +static void +continue_cancel_ptimer(ErtsSchedulerData *esdp, ErtsTimer *tmr) +{ +#ifdef ERTS_SMP + Uint32 sid = (tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK); + + if (esdp->no != sid) + queue_canceled_timer(esdp, sid, tmr); + else +#endif + cleanup_sched_local_canceled_timer(esdp, tmr); +} + +/* + * BIF timer specific + */ + +Uint erts_bif_timer_memory_size(void) +{ + return (Uint) 0; +} + +static BIF_RETTYPE +setup_bif_timer(Process *c_p, ErtsMonotonicTime timeout_pos, + int short_time, Eterm rcvr, Eterm acsr, + Eterm msg, int wrap) +{ + BIF_RETTYPE ret; + Eterm ref, tmo_msg, *hp; + ErtsHLTimer *tmr; + ErtsSchedulerData *esdp; + DeclareTmpHeap(tmp_hp, 4, c_p); + + if (is_not_internal_pid(rcvr) && is_not_atom(rcvr)) + goto badarg; + + esdp = ERTS_PROC_GET_SCHDATA(c_p); + + hp = HAlloc(c_p, REF_THING_SIZE); + ref = erts_sched_make_ref_in_buffer(esdp, hp); + + ASSERT(erts_get_ref_numbers_thr_id( + internal_ref_numbers(ref)) == (Uint32) esdp->no); + + UseTmpHeap(4, c_p); + + tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg; + + tmr = create_hl_timer(esdp, timeout_pos, short_time, 1, NULL, + rcvr, acsr, tmo_msg, internal_ref_numbers(ref)); + + UnUseTmpHeap(4, c_p); + + if (is_internal_pid(rcvr)) { + Process *proc = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + rcvr, ERTS_PROC_LOCK_BTM, + ERTS_P2P_FLG_INC_REFC); + if (!proc) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + hlt_delete_timer(esdp, tmr); + hl_timer_destroy(tmr); + } + else { + proc_btm_rbt_insert(&proc->bif_timers, tmr); + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + tmr->receiver.proc = proc; + } + } + + ERTS_BIF_PREP_RET(ret, ref); + return ret; + +badarg: + + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + return ret; +} + +static int +cancel_bif_timer(ErtsHLTimer *tmr) +{ + erts_aint_t state; + Uint32 roflgs; + int res; + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_CANCELED, + ERTS_TMR_STATE_ACTIVE); + if (state != ERTS_TMR_STATE_ACTIVE) + return 0; + + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + + res = -1; + + roflgs = tmr->head.roflgs; + if (roflgs & ERTS_TMR_ROFLG_PROC) { + Process *proc = tmr->receiver.proc; + ERTS_HLT_ASSERT(!(tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME)); + + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM); + /* + * If process is exiting, let it clean up + * the btm tree by itself (it may be in + * the middle of tree destruction). + */ + if (!ERTS_PROC_IS_EXITING(proc) + && tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + proc_btm_rbt_delete(&proc->bif_timers, tmr); + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + res = 1; + } + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + } + + return res; +} + +static ERTS_INLINE Eterm +access_sched_local_btm(Process *c_p, Eterm pid, + Eterm tref, Uint32 *trefn, + Uint32 *rrefn, + int async, int cancel, + int return_res, + int info) +{ + ErtsSchedulerData *esdp; + ErtsHLTimerService *srv; + ErtsHLTimer *tmr; + Sint64 time_left; + Process *proc; + ErtsProcLocks proc_locks; + + time_left = -1; + + if (!c_p) + esdp = erts_get_scheduler_data(); + else { + esdp = ERTS_PROC_GET_SCHDATA(c_p); + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + } + + ERTS_HLT_ASSERT(erts_get_ref_numbers_thr_id(trefn) + == (Uint32) esdp->no); + + srv = esdp->timer_service; + + tmr = btm_rbt_lookup(srv->btm_tree, trefn); + if (tmr) { + if (!cancel) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->state); + if (state == ERTS_TMR_STATE_ACTIVE) + time_left = get_time_left(esdp, tmr->timeout); + } + else { + int cncl_res = cancel_bif_timer(tmr); + if (cncl_res) { + + time_left = get_time_left(esdp, tmr->timeout); + + if (cncl_res > 0) + hl_timer_dec_refc(tmr, tmr->head.roflgs); + + hlt_delete_timer(esdp, tmr); + } + } + } + + if (!info) + return am_ok; + + if (return_res) { + ERTS_HLT_ASSERT(c_p); + if (time_left < 0) + return am_false; + else if (time_left <= (Sint64) MAX_SMALL) + return make_small((Sint) time_left); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(time_left); + Eterm *hp = HAlloc(c_p, hsz); + return erts_sint64_to_big(time_left, &hp); + } + } + + if (c_p) { + proc = c_p; + proc_locks = ERTS_PROC_LOCK_MAIN; + } + else { + proc = erts_proc_lookup(pid); + proc_locks = 0; + } + + if (proc) { + Uint hsz; + ErlOffHeap *ohp; + ErlHeapFragment* bp; + Eterm *hp, msg, ref, result; +#ifdef ERTS_HLT_DEBUG + Eterm *hp_end; +#endif + + hsz = 3; /* 2-tuple */ + if (!async) + hsz += REF_THING_SIZE; + else { + if (is_non_value(tref) || proc != c_p) + hsz += REF_THING_SIZE; + hsz += 1; /* upgrade to 3-tuple */ + } + if (time_left > (Sint64) MAX_SMALL) + hsz += ERTS_SINT64_HEAP_SIZE(time_left); + + if (proc == c_p) { + bp = NULL; + ohp = NULL; + hp = HAlloc(c_p, hsz); + } + else { + hp = erts_alloc_message_heap(hsz, + &bp, + &ohp, + proc, + &proc_locks); + } + +#ifdef ERTS_HLT_DEBUG + hp_end = hp + hsz; +#endif + + if (time_left < 0) + result = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + result = make_small((Sint) time_left); + else + result = erts_sint64_to_big(time_left, &hp); + + if (!async) { + write_ref_thing(hp, + rrefn[0], + rrefn[1], + rrefn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; + msg = TUPLE2(hp, ref, result); + + ERTS_HLT_ASSERT(hp + 3 == hp_end); + } + else { + Eterm tag = cancel ? am_cancel_timer : am_read_timer; + if (is_value(tref) && proc == c_p) + ref = tref; + else { + write_ref_thing(hp, + trefn[0], + trefn[1], + trefn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; + } + msg = TUPLE3(hp, tag, ref, result); + + ERTS_HLT_ASSERT(hp + 4 == hp_end); + + } + erts_queue_message(proc, &proc_locks, bp, msg, NIL); + + if (c_p) + proc_locks &= ~ERTS_PROC_LOCK_MAIN; + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + } + + return am_ok; +} + +#define ERTS_BTM_REQ_FLG_ASYNC (((Uint32) 1) << 0) +#define ERTS_BTM_REQ_FLG_CANCEL (((Uint32) 1) << 1) +#define ERTS_BTM_REQ_FLG_INFO (((Uint32) 1) << 2) + +typedef struct { + Eterm pid; + Uint32 trefn[ERTS_REF_NUMBERS]; + Uint32 rrefn[ERTS_REF_NUMBERS]; + Uint32 flags; +} ErtsBifTimerRequest; + +static void +bif_timer_access_request(void *vreq) +{ + ErtsBifTimerRequest *req = (ErtsBifTimerRequest *) vreq; + int async = (int) (req->flags & ERTS_BTM_REQ_FLG_ASYNC); + int cancel = (int) (req->flags & ERTS_BTM_REQ_FLG_CANCEL); + int info = (int) (req->flags & ERTS_BTM_REQ_FLG_INFO); + (void) access_sched_local_btm(NULL, req->pid, THE_NON_VALUE, + req->trefn, req->rrefn, async, + cancel, 0, info); + erts_free(ERTS_ALC_T_TIMER_REQUEST, vreq); +} + +static int +try_access_sched_remote_btm(ErtsSchedulerData *esdp, + Process *c_p, Uint32 sid, + Eterm tref, Uint32 *trefn, + int async, int cancel, + int info, Eterm *resp) +{ + ErtsHLTimer *tmr; + Sint64 time_left; + + ERTS_HLT_ASSERT(c_p); + + /* + * Check if the timer is aimed at current + * process of if this process is an accessor + * of the timer... + */ + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_BTM); + tmr = proc_btm_rbt_lookup(c_p->bif_timers, trefn); + if (!tmr) + tmr = abtm_rbt_lookup(c_p->accessor_bif_timers, trefn); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_BTM); + if (!tmr) + return 0; + + if (!cancel) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->state); + if (state == ERTS_TMR_STATE_ACTIVE) + time_left = get_time_left(esdp, tmr->timeout); + else + time_left = -1; + } + else { + int cncl_res = cancel_bif_timer(tmr); + if (!cncl_res) + time_left = -1; + else { + time_left = get_time_left(esdp, tmr->timeout); + if (cncl_res > 0) + queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); + } + } + + if (!info) { + *resp = am_ok; + return 1; + } + + if (!async) { + if (time_left < 0) + *resp = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + *resp = make_small((Sint) time_left); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(time_left); + Eterm *hp = HAlloc(c_p, hsz); + *resp = erts_sint64_to_big(time_left, &hp); + } + } + else { + Eterm tag, res, msg; + Uint hsz; + Eterm *hp; + ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; + + hsz = 4; + if (time_left > (Sint64) MAX_SMALL) + hsz += ERTS_SINT64_HEAP_SIZE(time_left); + + hp = HAlloc(c_p, hsz); + if (cancel) + tag = am_cancel_timer; + else + tag = am_read_timer; + + if (time_left < 0) + res = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + res = make_small((Sint) time_left); + else + res = erts_sint64_to_big(time_left, &hp); + + msg = TUPLE3(hp, tag, tref, res); + + erts_queue_message(c_p, &proc_locks, NULL, msg, NIL); + + proc_locks &= ~ERTS_PROC_LOCK_MAIN; + if (proc_locks) + erts_smp_proc_unlock(c_p, proc_locks); + + *resp = am_ok; + } + return 1; +} + +static BIF_RETTYPE +access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) +{ + BIF_RETTYPE ret; + ErtsSchedulerData *esdp; + Uint32 sid; + Uint32 *trefn; + Eterm res; + + if (is_not_internal_ref(tref)) { + if (is_not_ref(tref)) + goto badarg; + else + goto no_timer; + } + + esdp = ERTS_PROC_GET_SCHDATA(c_p); + + trefn = internal_ref_numbers(tref); + sid = erts_get_ref_numbers_thr_id(trefn); + if (sid < 1 || erts_no_schedulers < sid) + goto no_timer; + + if (sid == (Uint32) esdp->no) { + res = access_sched_local_btm(c_p, c_p->common.id, + tref, trefn, NULL, + async, cancel, !async, + info); + ERTS_BIF_PREP_RET(ret, res); + } + else if (try_access_sched_remote_btm(esdp, c_p, sid, + tref, trefn, + async, cancel, + info, &res)) { + ERTS_BIF_PREP_RET(ret, res); + } + else { + /* + * Schedule access for execution on + * remote scheduler... + */ + ErtsBifTimerRequest *req = erts_alloc(ERTS_ALC_T_TIMER_REQUEST, + sizeof(ErtsBifTimerRequest)); + + req->flags = 0; + if (cancel) + req->flags |= ERTS_BTM_REQ_FLG_CANCEL; + if (async) + req->flags |= ERTS_BTM_REQ_FLG_ASYNC; + if (info) + req->flags |= ERTS_BTM_REQ_FLG_INFO; + + req->pid = c_p->common.id; + + req->trefn[0] = trefn[0]; + req->trefn[1] = trefn[1]; + req->trefn[2] = trefn[2]; + + if (async) + ERTS_BIF_PREP_RET(ret, am_ok); + else { + Eterm *hp, rref; + Uint32 *rrefn; + + hp = HAlloc(c_p, REF_THING_SIZE); + rref = erts_sched_make_ref_in_buffer(esdp, hp); + rrefn = internal_ref_numbers(rref); + + req->rrefn[0] = rrefn[0]; + req->rrefn[1] = rrefn[1]; + req->rrefn[2] = rrefn[2]; + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + + if (ERTS_PROC_PENDING_EXIT(c_p)) + ERTS_VBUMP_ALL_REDS(c_p); + else { + /* + * Caller needs to wait for a message containing + * the ref that we just created. No such message + * can exist in callers message queue at this time. + * We therefore move the save pointer of the + * callers message queue to the end of the queue. + * + * NOTE: It is of vital importance that the caller + * immediately do a receive unconditionaly + * waiting for the message with the reference; + * otherwise, next receive will *not* work + * as expected! + */ + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + c_p->msg.save = c_p->msg.last; + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + + ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, rref); + } + + erts_schedule_misc_aux_work(sid, + bif_timer_access_request, + (void *) req); + } + + return ret; + +badarg: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + return ret; + +no_timer: + ERTS_BIF_PREP_RET(ret, am_false); + return ret; + +} + +static ERTS_INLINE int +bool_arg(Eterm val, int *argp) +{ + switch (val) { + case am_true: *argp = 1; return 1; + case am_false: *argp = 0; return 1; + default: return 0; + } +} + +static ERTS_INLINE int +parse_bif_timer_options(Eterm option_list, int *async, int *info, + int *abs, Eterm *accessor) +{ + Eterm list = option_list; + + if (async) + *async = 0; + if (info) + *info = 1; + if (abs) + *abs = 0; + if (accessor) + *accessor = THE_NON_VALUE; + + while (is_list(list)) { + Eterm *consp, *tp, opt; + + consp = list_val(list); + opt = CAR(consp); + if (is_not_tuple(opt)) + return 0; + + tp = tuple_val(opt); + if (arityval(tp[0]) != 2) + return 0; + + switch (tp[1]) { + case am_async: + if (!async || !bool_arg(tp[2], async)) + return 0; + break; + case am_info: + if (!info || !bool_arg(tp[2], info)) + return 0; + break; + case am_abs: + if (!abs || !bool_arg(tp[2], abs)) + return 0; + break; + case am_accessor: + if (!accessor || is_not_internal_pid(tp[2])) + return 0; + *accessor = tp[2]; + break; + default: + return 0; + } + + list = CDR(consp); + } + + if (is_not_nil(list)) + return 0; + return 1; +} + +static void +exit_cancel_bif_timer(ErtsHLTimer *tmr, void *vesdp) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + Uint32 sid, roflgs; + erts_aint_t state; + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_CANCELED, + ERTS_TMR_STATE_ACTIVE); + + roflgs = tmr->head.roflgs; + sid = roflgs & ERTS_TMR_ROFLG_SID_MASK; + + ERTS_HLT_ASSERT(sid == erts_get_ref_numbers_thr_id(tmr->btm.refn)); + ERTS_HLT_ASSERT(tmr->btm.proc_tree.parent + != ERTS_HLT_PFIELD_NOT_IN_TABLE); + + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + + if (sid == (Uint32) esdp->no) { + if (state == ERTS_TMR_STATE_ACTIVE) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + hlt_delete_timer(esdp, tmr); + } + hl_timer_dec_refc(tmr, roflgs); + } + else { + if (state == ERTS_TMR_STATE_ACTIVE) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); + } + else + hl_timer_dec_refc(tmr, roflgs); + } +} + +#ifdef ERTS_HLT_DEBUG +# define ERTS_BTM_MAX_DESTROY_LIMIT 2 +#else +# define ERTS_BTM_MAX_DESTROY_LIMIT 50 +#endif + +typedef struct { + ErtsBifTimers *bif_timers; + union { + proc_btm_rbt_yield_state_t proc_btm_yield_state; + abtm_rbt_yield_state_t abtm_yield_state; + } u; +} ErtsBifTimerYieldState; + +int erts_cancel_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(p); + ErtsBifTimerYieldState ys = {btm, {ERTS_RBT_YIELD_STAT_INITER}}; + ErtsBifTimerYieldState *ysp; + int res; + + ysp = (ErtsBifTimerYieldState *) *vyspp; + if (!ysp) + ysp = &ys; + + res = proc_btm_rbt_foreach_destroy_yielding(&ysp->bif_timers, + exit_cancel_bif_timer, + (void *) esdp, + &ysp->u.proc_btm_yield_state, + ERTS_BTM_MAX_DESTROY_LIMIT); + + if (res == 0) { + if (ysp != &ys) + erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp); + *vyspp = NULL; + } + else { + + if (ysp == &ys) { + ysp = erts_alloc(ERTS_ALC_T_BTM_YIELD_STATE, + sizeof(ErtsBifTimerYieldState)); + sys_memcpy((void *) ysp, (void *) &ys, + sizeof(ErtsBifTimerYieldState)); + } + + *vyspp = (void *) ysp; + } + + return res; +} + +static void +detach_bif_timer(ErtsHLTimer *tmr, void *vesdp) +{ + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +int erts_detach_accessor_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(p); + ErtsBifTimerYieldState ys = {btm, {ERTS_RBT_YIELD_STAT_INITER}}; + ErtsBifTimerYieldState *ysp; + int res; + + ysp = (ErtsBifTimerYieldState *) *vyspp; + if (!ysp) + ysp = &ys; + + res = abtm_rbt_foreach_destroy_yielding(&ysp->bif_timers, + detach_bif_timer, + (void *) esdp, + &ysp->u.abtm_yield_state, + ERTS_BTM_MAX_DESTROY_LIMIT); + + if (res == 0) { + if (ysp != &ys) + erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp); + *vyspp = NULL; + } + else { + + if (ysp == &ys) { + ysp = erts_alloc(ERTS_ALC_T_BTM_YIELD_STATE, + sizeof(ErtsBifTimerYieldState)); + sys_memcpy((void *) ysp, (void *) &ys, + sizeof(ErtsBifTimerYieldState)); + } + + *vyspp = (void *) ysp; + } + + return res; +} + +static ERTS_INLINE int +parse_timeout_pos(ErtsSchedulerData *esdp, Eterm arg, + ErtsMonotonicTime *conv_arg, int abs, + ErtsMonotonicTime *tposp, int *stimep) +{ + ErtsMonotonicTime t; + + if (!term_to_Sint64(arg, &t)) { + ERTS_HLT_ASSERT(!is_small(arg)); + if (!is_big(arg)) + return -1; + + if (abs || !big_sign(arg)) + return 1; + + return -1; + } + + if (conv_arg) + *conv_arg = t; + + if (abs) { + t += -1*ERTS_MONOTONIC_OFFSET_MSEC; /* external to internal */ + if (t < ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_BEGIN)) + return 1; + if (t > ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_END)) + return 1; + *stimep = (t - ERTS_MONOTONIC_TO_MSEC(esdp->last_monotonic_time) + < ERTS_BIF_TIMER_SHORT_TIME); + *tposp = ERTS_MSEC_TO_CLKTCKS(t); + } + else { + ErtsMonotonicTime now, ticks; + + if (t < 0) + return -1; + + ticks = ERTS_MSEC_TO_CLKTCKS(t); + + if (ERTS_CLKTCK_RESOLUTION > 1000 && ticks < 0) + return 1; + + ERTS_HLT_ASSERT(ticks >= 0); + + now = erts_get_monotonic_time(esdp); + ticks += ERTS_MONOTONIC_TO_CLKTCKS(now-1); + ticks += 1; + + if (ticks < ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_BEGIN)) + return 1; + if (ticks > ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_END)) + return 1; + + *stimep = (t < ERTS_BIF_TIMER_SHORT_TIME); + *tposp = ticks; + } + + return 0; +} + +/* + * + * The BIF timer BIFs... + */ + +BIF_RETTYPE send_after_3(BIF_ALIST_3) +{ + ErtsMonotonicTime timeout_pos; + int short_time, tres; + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + 0, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, BIF_ARG_2, BIF_ARG_3, 0); +} + +BIF_RETTYPE send_after_4(BIF_ALIST_4) +{ + ErtsMonotonicTime timeout_pos; + Eterm accessor; + int short_time, abs, tres; + + if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs, &accessor)) + BIF_ERROR(BIF_P, BADARG); + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + abs, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, accessor, BIF_ARG_3, 0); +} + +BIF_RETTYPE start_timer_3(BIF_ALIST_3) +{ + ErtsMonotonicTime timeout_pos; + int short_time, tres; + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + 0, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, BIF_ARG_2, BIF_ARG_3, !0); +} + +BIF_RETTYPE start_timer_4(BIF_ALIST_4) +{ + ErtsMonotonicTime timeout_pos; + Eterm accessor; + int short_time, abs, tres; + + if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs, &accessor)) + BIF_ERROR(BIF_P, BADARG); + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + abs, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, accessor, BIF_ARG_3, !0); +} + +BIF_RETTYPE cancel_timer_1(BIF_ALIST_1) +{ + return access_bif_timer(BIF_P, BIF_ARG_1, 1, 0, 1); +} + +BIF_RETTYPE cancel_timer_2(BIF_ALIST_2) +{ + BIF_RETTYPE ret; + int async, info; + + if (parse_bif_timer_options(BIF_ARG_2, &async, &info, NULL, NULL)) + return access_bif_timer(BIF_P, BIF_ARG_1, 1, async, info); + + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + return ret; +} + +BIF_RETTYPE read_timer_1(BIF_ALIST_1) +{ + return access_bif_timer(BIF_P, BIF_ARG_1, 0, 0, 1); +} + +BIF_RETTYPE read_timer_2(BIF_ALIST_2) +{ + BIF_RETTYPE ret; + int async; + + if (parse_bif_timer_options(BIF_ARG_2, &async, NULL, NULL, NULL)) + return access_bif_timer(BIF_P, BIF_ARG_1, 0, async, 1); + + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + return ret; +} + +/* + * Process and Port timer functionality. + * + * NOTE! These are only allowed to be called by a + * scheduler thread that currently is + * executing the process or port. + */ + +static ERTS_INLINE void +set_proc_timer_common(Process *c_p, ErtsSchedulerData *esdp, Sint64 tmo, + ErtsMonotonicTime timeout_pos, int short_time) +{ + void *tmr; + check_canceled_queue(esdp, esdp->timer_service); + + if (tmo == 0) + c_p->flags |= F_TIMO; + else { + + c_p->flags |= F_INSLPQUEUE; + c_p->flags &= ~F_TIMO; + + if (tmo < ERTS_TIMER_WHEEL_MSEC) + tmr = (void *) create_tw_timer(esdp, (void *) c_p, 1, timeout_pos); + else + tmr = (void *) create_hl_timer(esdp, timeout_pos, + short_time, 0, (void *) c_p, + c_p->common.id, NIL, NIL, NULL); + erts_smp_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr); + } +} + +int +erts_set_proc_timer_term(Process *c_p, Eterm etmo) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + ErtsMonotonicTime tmo, timeout_pos; + int short_time, tres; + + ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer) + == ERTS_PTMR_NONE); + + tres = parse_timeout_pos(esdp, etmo, &tmo, 0, + &timeout_pos, &short_time); + if (tres != 0) + return tres; + + if ((tmo >> 32) != 0) + return 1; + + set_proc_timer_common(c_p, esdp, tmo, timeout_pos, short_time); + return 0; +} + +void +erts_set_proc_timer_uword(Process *c_p, UWord tmo) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + + ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer) + == ERTS_PTMR_NONE); + +#ifndef ARCH_32 + ERTS_HLT_ASSERT((tmo >> 32) == (UWord) 0); +#endif + + if (tmo == 0) + c_p->flags |= F_TIMO; + else { + ErtsMonotonicTime timeout_pos; + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), + (ErtsMonotonicTime) tmo); + set_proc_timer_common(c_p, esdp, (ErtsMonotonicTime) tmo, + timeout_pos, + tmo < ERTS_BIF_TIMER_SHORT_TIME); + } +} + +void +erts_cancel_proc_timer(Process *c_p) +{ + erts_aint_t tval; + tval = erts_smp_atomic_xchg_acqb(&c_p->common.timer, + ERTS_PTMR_NONE); + c_p->flags &= ~(F_INSLPQUEUE|F_TIMO); + if (tval == ERTS_PTMR_NONE) + return; + if (tval == ERTS_PTMR_TIMEDOUT) { + erts_smp_atomic_set_nob(&c_p->common.timer, ERTS_PTMR_NONE); + return; + } + continue_cancel_ptimer(ERTS_PROC_GET_SCHDATA(c_p), + (ErtsTimer *) tval); +} + +void +erts_set_port_timer(Port *c_prt, Sint64 tmo) +{ + void *tmr; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ErtsMonotonicTime timeout_pos; + + if (erts_smp_atomic_read_nob(&c_prt->common.timer) != ERTS_PTMR_NONE) + erts_cancel_port_timer(c_prt); + + check_canceled_queue(esdp, esdp->timer_service); + + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), tmo); + + if (tmo < ERTS_TIMER_WHEEL_MSEC) + tmr = (void *) create_tw_timer(esdp, (void *) c_prt, 0, + timeout_pos); + else + tmr = (void *) create_hl_timer(esdp, timeout_pos, 0, 0, + (void *) c_prt, + c_prt->common.id, NIL, NIL, + NULL); + erts_smp_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr); +} + +void +erts_cancel_port_timer(Port *c_prt) +{ + erts_aint_t tval; + tval = erts_smp_atomic_xchg_acqb(&c_prt->common.timer, + ERTS_PTMR_NONE); + if (tval == ERTS_PTMR_NONE) + return; + if (tval == ERTS_PTMR_TIMEDOUT) { + while (!erts_port_task_is_scheduled(&c_prt->timeout_task)) + erts_thr_yield(); + erts_port_task_abort(&c_prt->timeout_task); + erts_smp_atomic_set_nob(&c_prt->common.timer, ERTS_PTMR_NONE); + return; + } + continue_cancel_ptimer(erts_get_scheduler_data(), + (ErtsTimer *) tval); +} + +Sint64 +erts_read_port_timer(Port *c_prt) +{ + ErtsTimer *tmr; + erts_aint_t itmr; + ErtsMonotonicTime timeout_pos; + + itmr = erts_smp_atomic_read_acqb(&c_prt->common.timer); + if (itmr == ERTS_PTMR_NONE) + return (Sint64) -1; + if (itmr == ERTS_PTMR_TIMEDOUT) + return (Sint64) 0; + tmr = (ErtsTimer *) itmr; + if (tmr->head.roflgs & ERTS_TMR_ROFLG_HLT) + timeout_pos = tmr->hlt.timeout; + else + timeout_pos = tmr->twt.tw_tmr.timeout_pos; + return get_time_left(NULL, timeout_pos); +} + +/* + * Debug stuff... + */ + +typedef struct { + int to; + void *to_arg; + ErtsMonotonicTime now; +} ErtsBTMPrint; + +static void +btm_print(ErtsHLTimer *tmr, void *vbtmp) +{ + ErtsBTMPrint *btmp = (ErtsBTMPrint *) vbtmp; + ErtsMonotonicTime left; + Eterm receiver; + + if (tmr->timeout <= btmp->now) + left = 0; + left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); + + receiver = ((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) + ? tmr->receiver.name + : tmr->receiver.proc->common.id); + + erts_print(btmp->to, btmp->to_arg, + "=timer:%T\n" + "Message: %T\n" + "Time left: %b64d\n", + receiver, + tmr->btm.message, + (Sint64) left); +} + +void +erts_print_bif_timer_info(int to, void *to_arg) +{ + ErtsBTMPrint btmp; + int six; + + if (!ERTS_IS_CRASH_DUMPING) + ERTS_INTERNAL_ERROR("Not crash dumping"); + + btmp.to = to; + btmp.to_arg = to_arg; + btmp.now = erts_get_monotonic_time(NULL); + btmp.now = ERTS_MONOTONIC_TO_CLKTCKS(btmp.now); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsHLTimerService *srv = + erts_aligned_scheduler_data[six].esd.timer_service; + btm_rbt_foreach(srv->btm_tree, btm_print, (void *) &btmp); + } +} + +typedef struct { + void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *); + void *arg; +} ErtsBTMForeachDebug; + +static void +debug_btm_foreach(ErtsHLTimer *tmr, void *vbtmfd) +{ + if (erts_smp_atomic32_read_nob(&tmr->state) == ERTS_TMR_STATE_ACTIVE) { + ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd; + (*btmfd->func)(((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) + ? tmr->receiver.name + : tmr->receiver.proc->common.id), + tmr->btm.message, + tmr->btm.bp, + btmfd->arg); + } +} + +void +erts_debug_bif_timer_foreach(void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *), + void *arg) +{ + ErtsBTMForeachDebug btmfd; + int six; + + btmfd.func = func; + btmfd.arg = arg; + + if (!erts_smp_thr_progress_is_blocking()) + ERTS_INTERNAL_ERROR("Not blocking thread progress"); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsHLTimerService *srv = + erts_aligned_scheduler_data[six].esd.timer_service; + btm_rbt_foreach(srv->btm_tree, + debug_btm_foreach, + (void *) &btmfd); + } +} + +#ifdef ERTS_HLT_HARD_DEBUG + +typedef struct { + ErtsHLTimerService *srv; + int found_root; + ErtsHLTimer **rootpp; +} ErtsHdbgHLT; + +static void +st_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer **rootpp; + ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME); + if (tmr->time.tree.parent == ERTS_HLT_PFLG_SAME_TIME) { + ERTS_HLT_ASSERT(tmr != *hdbg->rootpp); + } + else { + rootpp = (ErtsHLTimer **) (tmr->time.tree.parent + & ~ERTS_HLT_PFLG_SAME_TIME); + ERTS_HLT_ASSERT(rootpp == hdbg->rootpp); + ERTS_HLT_ASSERT(tmr == *rootpp); + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + } + ERTS_HLT_ASSERT(tmr->time.tree.u.l.next->time.tree.u.l.prev == tmr); + ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev->time.tree.u.l.next == tmr); + ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); +} + +static void +tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer *prnt; + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + prnt = (ErtsHLTimer *) (tmr->time.tree.parent & ~ERTS_HLT_PFLGS_MASK); + if (prnt) { + ERTS_HLT_ASSERT(prnt->time.tree.u.t.left == tmr + || prnt->time.tree.u.t.right == tmr); + } + else { + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + ERTS_HLT_ASSERT(tmr == *hdbg->rootpp); + } + if (tmr->time.tree.u.t.left) { + prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.left->time.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->time.tree.u.t.right) { + prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.right->time.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); + if (tmr->time.tree.same_time) { + ErtsHdbgHLT st_hdbg; + st_hdbg.srv = hdbg->srv; + st_hdbg.found_root = 0; + st_hdbg.rootpp = &tmr->time.tree.same_time; + same_time_list_foreach(tmr->time.tree.same_time, st_hdbg_func, (void *) &st_hdbg); + ERTS_HLT_ASSERT(st_hdbg.found_root); + } +} + +static void +bt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer *prnt; + ERTS_HLT_ASSERT((tmr->btm.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + prnt = (ErtsHLTimer *) (tmr->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK); + if (prnt) { + ERTS_HLT_ASSERT(prnt->btm.tree.left == tmr + || prnt->btm.tree.right == tmr); + } + else { + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + ERTS_HLT_ASSERT(tmr == *hdbg->rootpp); + } + if (tmr->btm.tree.left) { + prnt = (ErtsHLTimer *) (tmr->btm.tree.left->btm.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->btm.tree.right) { + prnt = (ErtsHLTimer *) (tmr->btm.tree.right->btm.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->pending_timeout) { + if (tmr->pending_timeout > 0) /* container > 0 */ + ERTS_HLT_ASSERT(tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE); + else { + ERTS_HLT_ASSERT(tmr->time.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE); + ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME); + } + } + else { + ErtsHLTimer *ttmr = time_rbt_lookup(hdbg->srv->time_tree, tmr->timeout); + ERTS_HLT_ASSERT(ttmr); + if (ttmr != tmr) { + ERTS_HLT_ASSERT(ttmr->time.tree.same_time); + ERTS_HLT_ASSERT(tmr == same_time_list_lookup(ttmr->time.tree.same_time, tmr)); + } + } +} + +static void +hdbg_chk_srv(ErtsHLTimerService *srv) +{ + if (srv->time_tree) { + ErtsHdbgHLT hdbg; + hdbg.srv = srv; + hdbg.found_root = 0; + hdbg.rootpp = &srv->time_tree; + time_rbt_foreach(srv->time_tree, tt_hdbg_func, (void *) &hdbg); + ERTS_HLT_ASSERT(hdbg.found_root); + } + if (srv->btm_tree) { + ErtsHdbgHLT hdbg; + hdbg.srv = srv; + hdbg.found_root = 0; + hdbg.rootpp = &srv->btm_tree; + btm_rbt_foreach(srv->btm_tree, bt_hdbg_func, (void *) &hdbg); + ERTS_HLT_ASSERT(hdbg.found_root); + } +} + +#endif /* ERTS_HLT_HARD_DEBUG */ diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h new file mode 100644 index 0000000000..30889a71da --- /dev/null +++ b/erts/emulator/beam/erl_hl_timer.h @@ -0,0 +1,80 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_HL_TIMER_H__ +#define ERL_HL_TIMER_H__ + +typedef struct ErtsHLTimer_ ErtsBifTimers; +typedef struct ErtsHLTimerService_ ErtsHLTimerService; + +#include "sys.h" +#include "erl_process.h" +#define ERL_PORT_GET_PORT_TYPE_ONLY__ +#include "erl_port.h" +#undef ERL_PORT_GET_PORT_TYPE_ONLY__ +#include "erl_message.h" +#include "erl_alloc_types.h" + +#define ERTS_PTMR_NONE ((erts_aint_t) NULL) +#define ERTS_PTMR_TIMEDOUT (ERTS_PTMR_NONE + ((erts_aint_t) 1)) + +#define ERTS_PTMR_INIT(P) \ + erts_smp_atomic_init_nob(&(P)->common.timer, ERTS_PTMR_NONE) +#define ERTS_PTMR_IS_SET(P) \ + (ERTS_PTMR_NONE != erts_smp_atomic_read_nob(&(P)->common.timer)) +#define ERTS_PTMR_IS_TIMED_OUT(P) \ + (ERTS_PTMR_TIMEDOUT == erts_smp_atomic_read_nob(&(P)->common.timer)) + +#define ERTS_PTMR_CLEAR(P) \ + do { \ + ASSERT(ERTS_PTMR_IS_TIMED_OUT((P))); \ + erts_smp_atomic_set_nob(&(P)->common.timer, \ + ERTS_PTMR_NONE); \ + } while (0) + +size_t erts_timer_type_size(ErtsAlcType_t type); +int erts_set_proc_timer_term(Process *, Eterm); +void erts_set_proc_timer_uword(Process *, UWord); +void erts_cancel_proc_timer(Process *); +void erts_set_port_timer(Port *, Sint64); +void erts_cancel_port_timer(Port *); +Sint64 erts_read_port_timer(Port *); +int erts_cancel_bif_timers(Process *, ErtsBifTimers *, void **); +int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **); +ErtsHLTimerService *erts_create_timer_service(void); +void erts_hl_timer_init(void); + +#ifdef ERTS_SMP +void +erts_handle_canceled_timers(void *vesdp, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work); +#endif + +Uint erts_bif_timer_memory_size(void); +void erts_print_bif_timer_info(int to, void *to_arg); + +void erts_debug_bif_timer_foreach(void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *), + void *arg); + +#endif /* ERL_HL_TIMER_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 4f12727044..988ff0e2b5 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -35,7 +35,7 @@ #include "dist.h" #include "erl_mseg.h" #include "erl_threads.h" -#include "erl_bif_timer.h" +#include "erl_hl_timer.h" #include "erl_instrument.h" #include "erl_printf_term.h" #include "erl_misc_utils.h" @@ -46,6 +46,8 @@ #include "erl_async.h" #include "erl_ptab.h" #include "erl_bif_unique.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" #ifdef HIPE #include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */ @@ -365,7 +367,6 @@ erl_init(int ncpu, erts_init_binary(); /* Must be after init_emulator() */ erts_bp_init(); init_db(); /* Must be after init_emulator */ - erts_bif_timer_init(); erts_init_node_tables(); init_dist(); erl_drv_thr_init(); @@ -2095,11 +2096,8 @@ erl_start(int argc, char **argv) erts_initialized = 1; - { - Eterm init = erl_first_process_otp("otp_ring0", NULL, 0, - boot_argc, boot_argv); - erts_bif_timer_start_servers(init); - } + (void) erl_first_process_otp("otp_ring0", NULL, 0, + boot_argc, boot_argv); #ifdef ERTS_SMP erts_start_schedulers(); @@ -2107,13 +2105,17 @@ erl_start(int argc, char **argv) erts_sys_main_thread(); /* May or may not return! */ #else - erts_thr_set_main_status(1, 1); + { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + erts_thr_set_main_status(1, 1); #if ERTS_USE_ASYNC_READY_Q - erts_get_scheduler_data()->aux_work_data.async_ready.queue - = erts_get_async_ready_queue(1); + esdp->aux_work_data.async_ready.queue + = erts_get_async_ready_queue(1); #endif - set_main_stack_size(); - process_main(); + set_main_stack_size(); + erts_sched_init_time_sup(esdp); + process_main(); + } #endif } diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 261460d054..617ce84895 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -91,6 +91,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "driver_list", NULL }, { "proc_link", "pid" }, { "proc_msgq", "pid" }, + { "proc_btm", "pid" }, { "dist_entry", "address" }, { "dist_entry_links", "address" }, { "code_write_permission", NULL }, diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index bb2a2bcdf9..a1bd39dbc8 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -1884,7 +1884,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) UseTmpHeapNoproc(2); ASSERT(is_boxed(node)); - ptr = boxed_val(node); + ptr = boxed_val_rel(node, map_base); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(is_hashmap_header_head(hdr)); @@ -1905,8 +1905,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) node = ptr[ix+1]; if (is_list(node)) { /* LEAF NODE [K|V] */ - ptr = list_val(node); - + ptr = list_val_rel(node,map_base); res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL; break; } @@ -1914,7 +1913,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) hx = hashmap_shift_hash(th,hx,lvl,key); ASSERT(is_boxed(node)); - ptr = boxed_val(node); + ptr = boxed_val_rel(node, map_base); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(!is_hashmap_header_head(hdr)); @@ -2586,12 +2585,12 @@ BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) { DECL_AM(hashmap); DECL_AM(hashmap_node); DECL_AM(flatmap); - if (is_flatmap(BIF_ARG_1)) { - BIF_RET(AM_flatmap); - } else if (is_hashmap(BIF_ARG_1)) { + if (is_map(BIF_ARG_1)) { Eterm hdr = *(boxed_val(BIF_ARG_1)); ASSERT(is_header(hdr)); switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_FLATMAP: + BIF_RET(AM_flatmap); case HAMT_SUBTAG_HEAD_ARRAY: case HAMT_SUBTAG_HEAD_BITMAP: BIF_RET(AM_hashmap); @@ -2612,23 +2611,22 @@ BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) { */ BIF_RETTYPE erts_internal_map_hashmap_children_1(BIF_ALIST_1) { - if (is_hashmap(BIF_ARG_1)) { + if (is_map(BIF_ARG_1)) { Eterm node = BIF_ARG_1; Eterm *ptr, hdr, *hp, res = NIL; Uint sz = 0; ptr = boxed_val(node); hdr = *ptr; - ASSERT(is_header(hdr)); switch(hdr & _HEADER_MAP_SUBTAG_MASK) { - case HAMT_SUBTAG_NODE_BITMAP: - sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); - ptr += 1; - break; + case HAMT_SUBTAG_HEAD_FLATMAP: + BIF_ERROR(BIF_P, BADARG); case HAMT_SUBTAG_HEAD_BITMAP: - sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); - ptr += 2; + ptr++; + case HAMT_SUBTAG_NODE_BITMAP: + ptr++; + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); break; case HAMT_SUBTAG_HEAD_ARRAY: sz = 16; @@ -2642,12 +2640,9 @@ BIF_RETTYPE erts_internal_map_hashmap_children_1(BIF_ALIST_1) { hp = HAlloc(BIF_P, 2*sz); while(sz--) { res = CONS(hp, *ptr++, res); hp += 2; } BIF_RET(res); - } else if (is_flatmap(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); - } else { - BIF_P->fvalue = BIF_ARG_1; - BIF_ERROR(BIF_P, BADMAP); } + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 247ea10764..ccfc2e6458 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -990,7 +990,7 @@ erts_send_message(Process* sender, #endif ); BM_SWAP_TIMER(send,system); - } else if (sender == receiver && !(sender->flags & F_OFF_HEAP_MSGS)) { + } else if (sender == receiver) { /* Drop message if receiver has a pending exit ... */ #ifdef ERTS_SMP ErtsProcLocks need_locks = (~(*receiver_locks) diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 8f9ea939e8..1e1dafee90 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -213,25 +213,15 @@ do { \ if ((M)->data.attached) { \ Uint need__ = erts_msg_attached_data_size((M)); \ if ((ST) - (HT) >= need__) { \ - Uint *htop__; \ - move__attached__msg__data____: \ - htop__ = (HT); \ + Uint *htop__ = (HT); \ erts_move_msg_attached_data_to_heap(&htop__, &MSO((P)), (M));\ ASSERT(htop__ - (HT) <= need__); \ (HT) = htop__; \ } \ else { \ - int off_heap_msgs__ = (int) (P)->flags & F_OFF_HEAP_MSGS; \ - if (!off_heap_msgs__) \ - need__ = 0; \ { SWPO ; } \ - (FC) -= erts_garbage_collect((P), need__, NULL, 0); \ + (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ { SWPI ; } \ - if (off_heap_msgs__) { \ - ASSERT((M)->data.attached); \ - ASSERT((ST) - (HT) >= need__); \ - goto move__attached__msg__data____; \ - } \ } \ ASSERT(!(M)->data.attached); \ } \ diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 25caaa4e44..426a00304e 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -336,7 +336,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, rp = (scheduler ? erts_proc_lookup(receiver) : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, - receiver, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC)); + receiver, rp_locks, ERTS_P2P_FLG_INC_REFC)); if (rp == NULL) { ASSERT(env == NULL || receiver != c_p->common.id); return 0; @@ -364,7 +364,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); if (flush_me) { cache_env(env); } diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index c6d136f951..bcf6311079 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1469,7 +1469,7 @@ setup_reference_table(void) erts_db_foreach_table(insert_ets_table, NULL); /* Insert all bif timers */ - erts_bif_timer_foreach(insert_bif_timer, NULL); + erts_debug_bif_timer_foreach(insert_bif_timer, NULL); /* Insert node table (references to dist) */ hash_foreach(&erts_node_table, insert_erl_node, NULL); diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index ad3f104a68..3920fae2d9 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -350,6 +350,7 @@ int erts_lc_is_port_locked(Port *); ERTS_GLB_INLINE void erts_port_inc_refc(Port *prt); ERTS_GLB_INLINE void erts_port_dec_refc(Port *prt); ERTS_GLB_INLINE void erts_port_add_refc(Port *prt, Sint32 add_refc); +ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt); ERTS_GLB_INLINE int erts_smp_port_trylock(Port *prt); ERTS_GLB_INLINE void erts_smp_port_lock(Port *prt); @@ -359,37 +360,26 @@ ERTS_GLB_INLINE void erts_smp_port_unlock(Port *prt); ERTS_GLB_INLINE void erts_port_inc_refc(Port *prt) { -#ifdef ERTS_SMP - erts_ptab_inc_refc(&prt->common); -#else - erts_atomic32_inc_nob(&prt->refc); -#endif + erts_ptab_atmc_inc_refc(&prt->common); } ERTS_GLB_INLINE void erts_port_dec_refc(Port *prt) { -#ifdef ERTS_SMP - int referred = erts_ptab_dec_test_refc(&prt->common); + int referred = erts_ptab_atmc_dec_test_refc(&prt->common); if (!referred) erts_port_free(prt); -#else - int refc = erts_atomic32_dec_read_nob(&prt->refc); - if (refc == 0) - erts_port_free(prt); -#endif } ERTS_GLB_INLINE void erts_port_add_refc(Port *prt, Sint32 add_refc) { -#ifdef ERTS_SMP - int referred = erts_ptab_add_test_refc(&prt->common, add_refc); + int referred = erts_ptab_atmc_add_test_refc(&prt->common, add_refc); if (!referred) erts_port_free(prt); -#else - int refc = erts_atomic32_add_read_nob(&prt->refc, add_refc); - if (refc == 0) - erts_port_free(prt); -#endif +} + +ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt) +{ + return erts_ptab_atmc_read_refc(&prt->common); } ERTS_GLB_INLINE int diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 2aa0a27197..c701737e26 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1646,6 +1646,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) erts_aint32_t state; int active; Uint64 start_time = 0; + ErtsSchedulerData *esdp = runq->scheduler; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1662,7 +1663,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) *curr_port_pp = pp; if (erts_sched_stat.enabled) { - ErtsSchedulerData *esdp = erts_get_scheduler_data(); Uint old = ERTS_PORT_SCHED_ID(pp, esdp->no); int migrated = old && old != esdp->no; @@ -1718,11 +1718,16 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) switch (ptp->type) { case ERTS_PORT_TASK_TIMEOUT: reset_handle(ptp); - reds = ERTS_PORT_REDS_TIMEOUT; - if (!(state & ERTS_PORT_SFLGS_DEAD)) { - DTRACE_DRIVER(driver_timeout, pp); - (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); - } + if (!ERTS_PTMR_IS_TIMED_OUT(pp)) + reds = 0; + else { + ERTS_PTMR_CLEAR(pp); + reds = ERTS_PORT_REDS_TIMEOUT; + if (!(state & ERTS_PORT_SFLGS_DEAD)) { + DTRACE_DRIVER(driver_timeout, pp); + (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); + } + } break; case ERTS_PORT_TASK_INPUT: reds = ERTS_PORT_REDS_INPUT; @@ -1879,7 +1884,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) runq->scheduler->reductions += reds; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); - ERTS_PORT_REDUCTIONS_EXECUTED(runq, reds); + ERTS_PORT_REDUCTIONS_EXECUTED(esdp, runq, reds); return res; } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 00c7b163c2..af8db519d4 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -44,8 +44,10 @@ #include "dtrace-wrapper.h" #include "erl_ptab.h" #include "erl_bif_unique.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" - +#define ERTS_CHECK_TIME_REDS CONTEXT_REDS #define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0) #define ERTS_DELAYED_WAKEUP_REDUCTIONS ((Uint64) CONTEXT_REDS/2) @@ -463,7 +465,7 @@ static int stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg); static void aux_work_timeout(void *unused); static void aux_work_timeout_early_init(int no_schedulers); static void aux_work_timeout_late_init(void); -static void setup_aux_work_timer(void); +static void setup_aux_work_timer(ErtsSchedulerData *esdp); static int execute_sys_tasks(Process *c_p, erts_aint32_t *statep, @@ -493,6 +495,8 @@ dbg_chk_aux_work_val(erts_aint32_t value) valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR; valid |= ERTS_SSI_AUX_WORK_DD; valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR; + valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS; + valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR; valid |= ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; #endif #if HAVE_ERTS_MSEG @@ -610,13 +614,11 @@ erts_pre_init_process(void) #endif } -#ifdef ERTS_SMP static void release_process(void *vproc) { - erts_smp_proc_dec_refc((Process *) vproc); + erts_proc_dec_refc((Process *) vproc); } -#endif /* initialize the scheduler */ void @@ -632,16 +634,18 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) erts_ptab_init_table(&erts_proc, ERTS_ALC_T_PROC_TABLE, -#ifdef ERTS_SMP release_process, -#else - NULL, -#endif (ErtsPTabElementCommon *) &erts_invalid_process.common, proc_tab_size, sizeof(Process), "process_table", - legacy_proc_tab); + legacy_proc_tab, +#ifdef ERTS_SMP + 1 +#else + 0 +#endif + ); last_reductions = 0; last_exact_reductions = 0; @@ -1031,7 +1035,7 @@ reply_sched_wall_time(void *vswtrp) if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); if (erts_smp_atomic32_dec_read_nob(&swtrp->refc) == 0) swtreq_free(vswtrp); @@ -1063,7 +1067,7 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable) erts_smp_atomic32_init_nob(&swtrp->refc, (erts_aint32_t) erts_no_schedulers); - erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + erts_proc_add_refc(c_p, (Sint32) erts_no_schedulers); #ifdef ERTS_SMP if (erts_no_schedulers > 1) @@ -1124,7 +1128,7 @@ erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data) xplocks &= ~plocks; if (xplocks && erts_smp_proc_trylock(p, xplocks) == EBUSY) { if (xplocks & ERTS_PROC_LOCK_MAIN) { - erts_smp_proc_inc_refc(p); + erts_proc_inc_refc(p); erts_smp_proc_unlock(p, plocks); erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL); refc = 1; @@ -1140,7 +1144,7 @@ erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data) if (xplocks) erts_smp_proc_unlock(p, xplocks); if (refc) - erts_smp_proc_dec_refc(p); + erts_proc_dec_refc(p); ASSERT(p->psd); if (p->psd != psd) erts_free(ERTS_ALC_T_PSD, psd); @@ -1768,6 +1772,101 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i } /* + * Canceled timers + */ + +void +erts_notify_canceled_timer(ErtsSchedulerData *esdp, int rsid) +{ + ASSERT(esdp && esdp == erts_get_scheduler_data()); + if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) + schedule_aux_work_wakeup(&esdp->aux_work_data, + rsid, + ERTS_SSI_AUX_WORK_CNCLD_TMRS); + else + set_aux_work_flags_wakeup_relb(ERTS_SCHED_SLEEP_INFO_IX(rsid-1), + ERTS_SSI_AUX_WORK_CNCLD_TMRS); +} + +static ERTS_INLINE erts_aint32_t +handle_canceled_timers(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) +{ + ErtsSchedulerSleepInfo *ssi = awdp->ssi; + int need_thr_progress = 0; + ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; + int more_work = 0; + +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS); + erts_handle_canceled_timers((void *) awdp->esdp, + &need_thr_progress, + &wakeup, + &more_work); + if (more_work) { + if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS) + & ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR) { + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR); + aux_work &= ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR; + } + return aux_work; + } + + if (need_thr_progress) { + if (wakeup == ERTS_THR_PRGR_INVALID) + wakeup = erts_thr_progress_later(awdp->esdp); + awdp->cncld_tmrs.thr_prgr = wakeup; + set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR); + haw_thr_prgr_soft_wakeup(awdp, wakeup); + } + return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS; +} + +static ERTS_INLINE erts_aint32_t +handle_canceled_timers_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) +{ + ErtsSchedulerSleepInfo *ssi; + int need_thr_progress; + int more_work; + ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; + ErtsThrPrgrVal current = haw_thr_prgr_current(awdp); + +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif + if (!erts_thr_progress_has_reached_this(current, awdp->cncld_tmrs.thr_prgr)) + return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR; + + ssi = awdp->ssi; + need_thr_progress = 0; + more_work = 0; + + erts_handle_canceled_timers((void *) awdp->esdp, + &need_thr_progress, + &wakeup, + &more_work); + if (more_work) { + set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS); + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR); + return ((aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR) + | ERTS_SSI_AUX_WORK_CNCLD_TMRS); + } + + if (need_thr_progress) { + if (wakeup == ERTS_THR_PRGR_INVALID) + wakeup = erts_thr_progress_later(awdp->esdp); + awdp->cncld_tmrs.thr_prgr = wakeup; + haw_thr_prgr_soft_wakeup(awdp, wakeup); + } + else { + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR); + } + + return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR; +} + +/* * Handle scheduled thread progress later operations. */ #define ERTS_MAX_THR_PRGR_LATER_OPS 50 @@ -1865,7 +1964,7 @@ completed_dealloc(void *vproc) { if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == 0) { erts_resume((Process *) vproc, (ErtsProcLocks) 0); - erts_smp_proc_dec_refc((Process *) vproc); + erts_proc_dec_refc((Process *) vproc); } } @@ -1914,7 +2013,7 @@ erts_debug_wait_deallocations(Process *c_p) count, 0)) { erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); - erts_smp_proc_inc_refc(c_p); + erts_proc_inc_refc(c_p); /* scheduler threads */ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers, @@ -2029,7 +2128,7 @@ static ERTS_INLINE erts_aint32_t handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO); - setup_aux_work_timer(); + setup_aux_work_timer(awdp->esdp); return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO; } @@ -2089,6 +2188,11 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) #ifdef ERTS_SMP HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP, handle_thr_prgr_later_op); + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS, + handle_canceled_timers); + /* CNCLD_TMRS must be before CNCLD_TMRS_THR_PRGR */ + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR, + handle_canceled_timers_thr_prgr); #endif #if ERTS_USE_ASYNC_READY_Q @@ -2138,8 +2242,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) typedef struct { union { - ErlTimer data; - char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErlTimer))]; + ErtsTWheelTimer data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsTWheelTimer))]; } timer; int initialized; @@ -2149,6 +2253,22 @@ typedef struct { static ErtsAuxWorkTmo *aux_work_tmo; +static ERTS_INLINE void +start_aux_work_timer(ErtsSchedulerData *esdp) +{ + ErtsMonotonicTime tmo = erts_get_monotonic_time(esdp); + tmo = ERTS_MONOTONIC_TO_CLKTCKS(tmo-1); + tmo += ERTS_MSEC_TO_CLKTCKS(1000) + 1; + erts_twheel_init_timer(&aux_work_tmo->timer.data); + ASSERT(esdp); + erts_twheel_set_timer(esdp->timer_wheel, + &aux_work_tmo->timer.data, + aux_work_timeout, + NULL, + (void *) esdp, + tmo); +} + static void aux_work_timeout_early_init(int no_schedulers) { @@ -2181,18 +2301,12 @@ void aux_work_timeout_late_init(void) { aux_work_tmo->initialized = 1; - if (erts_atomic32_read_nob(&aux_work_tmo->refc)) { - erts_init_timer(&aux_work_tmo->timer.data); - erts_set_timer(&aux_work_tmo->timer.data, - aux_work_timeout, - NULL, - NULL, - 1000); - } + if (erts_atomic32_read_nob(&aux_work_tmo->refc)) + start_aux_work_timer(erts_get_scheduler_data()); } static void -aux_work_timeout(void *unused) +aux_work_timeout(void *vesdp) { erts_aint32_t refc; int i; @@ -2215,31 +2329,18 @@ aux_work_timeout(void *unused) if (refc != 1 || 1 != erts_atomic32_cmpxchg_relb(&aux_work_tmo->refc, 0, 1)) { /* Setup next timeout... */ - erts_set_timer(&aux_work_tmo->timer.data, - aux_work_timeout, - NULL, - NULL, - 1000); + start_aux_work_timer((ErtsSchedulerData *) vesdp); } } static void -setup_aux_work_timer(void) +setup_aux_work_timer(ErtsSchedulerData *esdp) { -#ifndef ERTS_SMP - if (!erts_get_scheduler_data()) + if (!esdp || !esdp->timer_wheel) set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(0), ERTS_SSI_AUX_WORK_SET_TMO); else -#endif - { - erts_init_timer(&aux_work_tmo->timer.data); - erts_set_timer(&aux_work_tmo->timer.data, - aux_work_timeout, - NULL, - NULL, - 1000); - } + start_aux_work_timer(esdp); } erts_aint32_t @@ -2270,7 +2371,7 @@ erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable) if (refc == 1) { erts_atomic32_inc_acqb(&aux_work_tmo->refc); if (aux_work_tmo->initialized) - setup_aux_work_timer(); + setup_aux_work_timer(erts_get_scheduler_data()); } } return old; @@ -2649,11 +2750,6 @@ aux_thread(void *unused) erts_aint32_t aux_work; ErtsThrPrgrCallbacks callbacks; int thr_prgr_active = 1; - ErtsTimerWheel *timer_wheel = erts_default_timer_wheel; - ErtsNextTimeoutRef nxt_tmo_ref = erts_get_next_timeout_reference(timer_wheel); - - if (!timer_wheel) - ERTS_INTERNAL_ERROR("Missing aux timer wheel"); #ifdef ERTS_ENABLE_LOCK_CHECK { @@ -2677,7 +2773,6 @@ aux_thread(void *unused) sched_prep_spin_wait(ssi); while (1) { - ErtsMonotonicTime current_time; erts_aint32_t flgs; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); @@ -2689,56 +2784,28 @@ aux_thread(void *unused) erts_thr_progress_leader_update(NULL); } - if (aux_work) { - current_time = erts_get_monotonic_time(); - if (current_time >= erts_next_timeout_time(nxt_tmo_ref)) { - if (!thr_prgr_active) - erts_thr_progress_active(NULL, thr_prgr_active = 1); - erts_bump_timers(timer_wheel, current_time); - } - } - else { - ErtsMonotonicTime timeout_time; - timeout_time = erts_check_next_timeout_time(timer_wheel, - ERTS_SEC_TO_MONOTONIC(10*60)); - current_time = erts_get_monotonic_time(); - if (current_time >= timeout_time) { - if (!thr_prgr_active) - erts_thr_progress_active(NULL, thr_prgr_active = 1); - } - else { - if (thr_prgr_active) - erts_thr_progress_active(NULL, thr_prgr_active = 0); - erts_thr_progress_prepare_wait(NULL); + if (!aux_work) { + if (thr_prgr_active) + erts_thr_progress_active(NULL, thr_prgr_active = 0); + erts_thr_progress_prepare_wait(NULL); - ERTS_SCHED_FAIR_YIELD(); + ERTS_SCHED_FAIR_YIELD(); - flgs = sched_spin_wait(ssi, 0); + flgs = sched_spin_wait(ssi, 0); + if (flgs & ERTS_SSI_FLG_SLEEPING) { + ASSERT(flgs & ERTS_SSI_FLG_WAITING); + flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); if (flgs & ERTS_SSI_FLG_SLEEPING) { + int res; + ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); - if (flgs & ERTS_SSI_FLG_SLEEPING) { - int res; - ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); - ASSERT(flgs & ERTS_SSI_FLG_WAITING); - current_time = erts_get_monotonic_time(); - do { - Sint64 timeout; - if (current_time >= timeout_time) - break; - timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time - - current_time - - 1) + 1; - res = erts_tse_twait(ssi->event, timeout); - current_time = erts_get_monotonic_time(); - } while (res == EINTR); - } + do { + res = erts_tse_wait(ssi->event); + } while (res == EINTR); } - erts_thr_progress_finalize_wait(NULL); } - if (current_time >= timeout_time) - erts_bump_timers(timer_wheel, current_time); + erts_thr_progress_finalize_wait(NULL); } flgs = sched_prep_spin_wait(ssi); @@ -2821,7 +2888,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (aux_work) { flgs = erts_smp_atomic32_read_acqb(&ssi->flags); - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) { if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); @@ -2832,9 +2899,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) } else { ErtsMonotonicTime timeout_time; - timeout_time = erts_check_next_timeout_time(esdp->timer_wheel, - ERTS_SEC_TO_MONOTONIC(10*60)); - current_time = erts_get_monotonic_time(); + timeout_time = erts_check_next_timeout_time(esdp); + current_time = erts_get_monotonic_time(esdp); if (current_time >= timeout_time) { if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); @@ -2860,7 +2926,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) int res; ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); do { Sint64 timeout; if (current_time >= timeout_time) @@ -2869,7 +2935,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) - current_time - 1) + 1; res = erts_tse_twait(ssi->event, timeout); - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); } while (res == EINTR); } } @@ -2944,7 +3010,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); erl_sys_schedule(1); /* Might give us something to do */ - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) erts_bump_timers(esdp->timer_wheel, current_time); @@ -3062,7 +3128,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erl_sys_schedule(0); { - ErtsMonotonicTime current_time = erts_get_monotonic_time(); + ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) erts_bump_timers(esdp->timer_wheel, current_time); } @@ -5273,6 +5339,7 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp) awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; awdp->dd.completed_callback = NULL; awdp->dd.completed_arg = NULL; + awdp->cncld_tmrs.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; awdp->later_op.thr_prgr = ERTS_THR_PRGR_VAL_FIRST; awdp->later_op.size = 0; awdp->later_op.first = NULL; @@ -5338,9 +5405,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->no = (Uint) num; #endif - esdp->timer_wheel = erts_default_timer_wheel; - esdp->next_tmo_ref = erts_get_next_timeout_reference(esdp->timer_wheel); - esdp->ssi = ssi; esdp->current_process = NULL; esdp->current_port = NULL; @@ -5353,6 +5417,9 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->run_queue = runq; esdp->run_queue->scheduler = esdp; + esdp->last_monotonic_time = 0; + esdp->check_time_reds = 0; + esdp->thr_id = (Uint32) num; erts_sched_bif_unique_init(esdp); @@ -5916,13 +5983,6 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces int check_emigration_need; #endif -#ifdef ERTS_SMP - if ((p->static_flags & ERTS_STC_FLG_PREFER_SCHED) - && p->preferred_run_queue != RUNQ_READ_RQ(&p->run_queue)) { - RUNQ_SET_RQ(&p->run_queue, p->preferred_run_queue); - } -#endif - a = state; while (1) { @@ -6730,6 +6790,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) } } + (void) erts_get_monotonic_time(esdp); erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); @@ -6863,7 +6924,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) } if (aux_work) { - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) { if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); @@ -6874,9 +6935,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) } else { ErtsMonotonicTime timeout_time; - timeout_time = erts_check_next_timeout_time(esdp->timer_wheel, - ERTS_SEC_TO_MONOTONIC(60*60)); - current_time = erts_get_monotonic_time(); + timeout_time = erts_check_next_timeout_time(esdp); + current_time = erts_get_monotonic_time(esdp); if (current_time >= timeout_time) { if (!thr_prgr_active) { @@ -6902,7 +6962,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) | ERTS_SSI_FLG_SUSPENDED)) { int res; - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); do { Sint64 timeout; if (current_time >= timeout_time) @@ -6911,7 +6971,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) - current_time - 1) + 1; res = erts_tse_twait(ssi->event, timeout); - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); } while (res == EINTR); } } @@ -7739,8 +7799,8 @@ sched_thread_func(void *vesdp) ErtsSchedulerData *esdp = vesdp; Uint no = esdp->no; - esdp->timer_wheel = erts_create_timer_wheel((int) no); - esdp->next_tmo_ref = erts_get_next_timeout_reference(esdp->timer_wheel); + erts_sched_init_time_sup(esdp); + #ifdef ERTS_SMP ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch(); callbacks.arg = (void *) esdp->ssi; @@ -9109,7 +9169,7 @@ Process *schedule(Process *p, int calls) schedule_out_process(rq, state, p, proxy_p); /* Returns with rq locked! */ proxy_p = NULL; - ERTS_PROC_REDUCTIONS_EXECUTED(rq, + ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, (int) ERTS_PSFLGS_GET_USR_PRIO(state), reds, actual_reds); @@ -9126,12 +9186,9 @@ Process *schedule(Process *p, int calls) ASSERT(esdp->free_process == p); esdp->free_process = NULL; #else - state = erts_smp_atomic32_read_nob(&p->state); - if (!(state & ERTS_PSFLG_IN_RUNQ)) - erts_free_proc(p); + erts_proc_dec_refc(p); #endif } - #ifdef ERTS_SMP ASSERT(!esdp->free_process); #endif @@ -9139,13 +9196,13 @@ Process *schedule(Process *p, int calls) ERTS_SMP_CHK_NO_PROC_LOCKS; - { - ErtsMonotonicTime current_time = erts_get_monotonic_time(); - if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) { - erts_smp_runq_unlock(rq); - erts_bump_timers(esdp->timer_wheel, current_time); - erts_smp_runq_lock(rq); - } + if (esdp->check_time_reds >= ERTS_CHECK_TIME_REDS) + (void) erts_get_monotonic_time(esdp); + + if (esdp->last_monotonic_time >= erts_next_timeout_time(esdp->next_tmo_ref)) { + erts_smp_runq_unlock(rq); + erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time); + erts_smp_runq_lock(rq); } BM_STOP_TIMER(system); @@ -9305,7 +9362,7 @@ Process *schedule(Process *p, int calls) erts_smp_runq_unlock(rq); erl_sys_schedule(1); - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) erts_bump_timers(esdp->timer_wheel, current_time); @@ -9446,13 +9503,8 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_PENDING_EXIT | ERTS_PSFLG_ACTIVE_SYS)) == ERTS_PSFLG_SUSPENDED)) { - if (state & ERTS_PSFLG_FREE) { -#ifdef ERTS_SMP - erts_smp_proc_dec_refc(p); -#else - erts_free_proc(p); -#endif - } + if (state & ERTS_PSFLG_FREE) + erts_proc_dec_refc(p); if (proxy_p) { free_proxy_proc(proxy_p); proxy_p = NULL; @@ -9595,6 +9647,20 @@ Process *schedule(Process *p, int calls) /* Never run a suspended process */ ASSERT(!(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&p->state))); + ASSERT(erts_proc_read_refc(p) > 0); + + if (ERTS_PTMR_IS_TIMED_OUT(p)) { + BeamInstr** pi; +#ifdef ERTS_SMP + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); +#endif + pi = (BeamInstr **) p->def_arg_reg; + p->i = *pi; + p->flags &= ~F_INSLPQUEUE; + p->flags |= F_TIMO; + ERTS_PTMR_CLEAR(p); + } + return p; } } @@ -10503,6 +10569,8 @@ erts_free_proc(Process *p) #ifdef ERTS_SMP erts_proc_lock_fin(p); #endif + ASSERT(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE); + ASSERT(0 == erts_proc_read_refc(p)); erts_free(ERTS_ALC_T_PROC, (void *) p); } @@ -10555,6 +10623,8 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state) return NULL; } + ASSERT(erts_proc_read_refc(p) > 0); + ASSERT(internal_pid_serial(p->common.id) <= ERTS_MAX_PID_SERIAL); p->approx_started = erts_get_approx_time(); @@ -10604,10 +10674,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). int ix = so->scheduler-1; ASSERT(0 <= ix && ix < erts_no_run_queues); rq = ERTS_RUNQ_IX(ix); - if (!(so->flags & SPO_PREFER_SCHED)) { - /* Unsupported feature... */ - state |= ERTS_PSFLG_BOUND; - } + /* Unsupported feature... */ + state |= ERTS_PSFLG_BOUND; } prio = (erts_aint32_t) so->priority; } @@ -10615,9 +10683,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). state |= (((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_ACT_PRIO_OFFSET) | ((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_USR_PRIO_OFFSET)); - if (so->flags & SPO_OFF_HEAP_MSGS) - state |= ERTS_PSFLG_OFF_HEAP_MSGS; - if (!rq) rq = erts_get_runq_proc(parent); @@ -10641,12 +10706,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). heap_need = arg_size; p->flags = erts_default_process_flags; - if (so->flags & SPO_OFF_HEAP_MSGS) - p->flags |= F_OFF_HEAP_MSGS; -#ifdef ERTS_SMP - p->preferred_run_queue = NULL; -#endif p->static_flags = 0; if (so->flags & SPO_SYSTEM_PROC) p->static_flags |= ERTS_STC_FLG_SYSTEM_PROC; @@ -10654,12 +10714,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->min_heap_size = so->min_heap_size; p->min_vheap_size = so->min_vheap_size; p->max_gen_gcs = so->max_gen_gcs; - if (so->flags & SPO_PREFER_SCHED) { -#ifdef ERTS_SMP - p->preferred_run_queue = rq; -#endif - p->static_flags |= ERTS_STC_FLG_PREFER_SCHED; - } } else { p->min_heap_size = H_MIN_SIZE; p->min_vheap_size = BIN_VH_MIN_SIZE; @@ -10668,9 +10722,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->schedule_count = 0; ASSERT(p->min_heap_size == erts_next_heap_size(p->min_heap_size, 0)); - p->initial[INITIAL_MOD] = mod; - p->initial[INITIAL_FUN] = func; - p->initial[INITIAL_ARI] = (Uint) arity; + p->u.initial[INITIAL_MOD] = mod; + p->u.initial[INITIAL_FUN] = func; + p->u.initial[INITIAL_ARI] = (Uint) arity; /* * Must initialize binary lists here before copying binaries to process. @@ -10711,7 +10765,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). /* No need to initialize p->fcalls. */ - p->current = p->initial+INITIAL_MOD; + p->current = p->u.initial+INITIAL_MOD; p->i = (BeamInstr *) beam_apply; p->cp = (BeamInstr *) beam_apply+1; @@ -10734,11 +10788,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->ftrace = NIL; p->reds = 0; -#ifdef ERTS_SMP - p->common.u.alive.ptimer = NULL; -#else - erts_init_timer(&p->common.u.alive.tm); -#endif + ERTS_PTMR_INIT(p); p->common.u.alive.reg = NULL; ERTS_P_LINKS(p) = NULL; @@ -10769,7 +10819,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->msg_inq.last = &p->msg_inq.first; p->msg_inq.len = 0; #endif - p->u.bif_timers = NULL; + p->bif_timers = NULL; + p->accessor_bif_timers = NULL; p->mbuf = NULL; p->mbuf_sz = 0; p->psd = NULL; @@ -10927,11 +10978,7 @@ void erts_init_empty_process(Process *p) p->bin_old_vheap = 0; p->sys_task_qs = NULL; p->bin_vheap_mature = 0; -#ifdef ERTS_SMP - p->common.u.alive.ptimer = NULL; -#else - erts_init_timer(&p->common.u.alive.tm); -#endif + ERTS_PTMR_INIT(p); p->next = NULL; p->off_heap.first = NULL; p->off_heap.overhead = 0; @@ -10952,14 +10999,15 @@ void erts_init_empty_process(Process *p) p->msg.last = &p->msg.first; p->msg.save = &p->msg.first; p->msg.len = 0; - p->u.bif_timers = NULL; + p->bif_timers = NULL; + p->accessor_bif_timers = NULL; p->dictionary = NULL; p->seq_trace_clock = 0; p->seq_trace_lastcnt = 0; p->seq_trace_token = NIL; - p->initial[0] = 0; - p->initial[1] = 0; - p->initial[2] = 0; + p->u.initial[0] = 0; + p->u.initial[1] = 0; + p->u.initial[2] = 0; p->catches = 0; p->cp = NULL; p->i = NULL; @@ -11007,7 +11055,6 @@ void erts_init_empty_process(Process *p) p->pending_suspenders = NULL; p->pending_exit.reason = THE_NON_VALUE; p->pending_exit.bp = NULL; - p->preferred_run_queue = NULL; erts_proc_lock_init(p); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); RUNQ_SET_RQ(&p->run_queue, ERTS_RUNQ_IX(0)); @@ -11047,7 +11094,8 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->suspend_monitors == NULL); ASSERT(p->msg.first == NULL); ASSERT(p->msg.len == 0); - ASSERT(p->u.bif_timers == NULL); + ASSERT(p->bif_timers == NULL); + ASSERT(p->accessor_bif_timers == NULL); ASSERT(p->dictionary == NULL); ASSERT(p->catches == 0); ASSERT(p->cp == NULL); @@ -11211,7 +11259,6 @@ set_proc_exiting(Process *p, */ p->freason = EXTAG_EXIT; KILL_CATCHES(p); - cancel_timer(p); p->i = (BeamInstr *) beam_exit; if (enqueue) @@ -11901,6 +11948,7 @@ erts_do_exit_process(Process* p, Eterm reason) { p->arity = 0; /* No live registers */ p->fvalue = reason; + #ifdef USE_VM_PROBES if (DTRACE_ENABLED(process_exit)) { @@ -11955,20 +12003,20 @@ erts_do_exit_process(Process* p, Eterm reason) ASSERT((ERTS_TRACE_FLAGS(p) & F_INITIAL_TRACE_FLAGS) == F_INITIAL_TRACE_FLAGS); - cancel_timer(p); /* Always cancel timer just in case */ - - if (p->u.bif_timers) - erts_cancel_bif_timers(p, ERTS_PROC_LOCKS_ALL); + ASSERT(erts_proc_read_refc(p) > 0); + if (ERTS_PTMR_IS_SET(p)) { + erts_cancel_proc_timer(p); + ASSERT(erts_proc_read_refc(p) > 0); + } erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); /* - * The p->u.bif_timers of this process can *not* be used anymore; + * p->u.initial of this process can *not* be used anymore; * will be overwritten by misc termination data. */ p->u.terminate = NULL; - erts_continue_exit_process(p); } @@ -11993,6 +12041,27 @@ erts_continue_exit_process(Process *p) ASSERT(ERTS_PROC_IS_EXITING(p)); + ASSERT(erts_proc_read_refc(p) > 0); + if (p->bif_timers) { + if (erts_cancel_bif_timers(p, p->bif_timers, &p->u.terminate)) { + ASSERT(erts_proc_read_refc(p) > 0); + goto yield; + } + ASSERT(erts_proc_read_refc(p) > 0); + p->bif_timers = NULL; + } + + if (p->accessor_bif_timers) { + if (erts_detach_accessor_bif_timers(p, + p->accessor_bif_timers, + &p->u.terminate)) { + ASSERT(erts_proc_read_refc(p) > 0); + goto yield; + } + ASSERT(erts_proc_read_refc(p) > 0); + p->accessor_bif_timers = NULL; + } + #ifdef ERTS_SMP if (p->flags & F_HAVE_BLCKD_MSCHED) { ErtsSchedSuspendResult ssr; @@ -12086,6 +12155,8 @@ erts_continue_exit_process(Process *p) p->scheduler_data->current_process = NULL; p->scheduler_data->free_process = p; +#else + erts_proc_inc_refc(p); /* Decremented in schedule() */ #endif /* Time of death! */ @@ -12104,29 +12175,23 @@ erts_continue_exit_process(Process *p) { /* Inactivate and notify free */ erts_aint32_t n, e, a = erts_smp_atomic32_read_nob(&p->state); -#ifdef ERTS_SMP int refc_inced = 0; -#endif while (1) { n = e = a; ASSERT(a & ERTS_PSFLG_EXITING); n |= ERTS_PSFLG_FREE; n &= ~ERTS_PSFLG_ACTIVE; -#ifdef ERTS_SMP if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) { - erts_smp_proc_inc_refc(p); + erts_proc_inc_refc(p); refc_inced = 1; } -#endif a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); if (a == e) break; } -#ifdef ERTS_SMP if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ)) - erts_smp_proc_dec_refc(p); -#endif + erts_proc_dec_refc(p); } dep = ((p->flags & F_DISTRIBUTION) @@ -12217,64 +12282,6 @@ erts_continue_exit_process(Process *p) } -/* Callback for process timeout */ -static void -timeout_proc(Process* p) -{ - erts_aint32_t state; - BeamInstr** pi = (BeamInstr **) p->def_arg_reg; - p->i = *pi; - p->flags |= F_TIMO; - p->flags &= ~F_INSLPQUEUE; - - state = erts_smp_atomic32_read_acqb(&p->state); - if (!(state & ERTS_PSFLG_ACTIVE)) - schedule_process(p, state, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); -} - - -void -cancel_timer(Process* p) -{ - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); - p->flags &= ~(F_INSLPQUEUE|F_TIMO); -#ifdef ERTS_SMP - erts_cancel_smp_ptimer(p->common.u.alive.ptimer); -#else - erts_cancel_timer(&p->common.u.alive.tm); -#endif -} - -/* - * Insert a process into the time queue, with a timeout 'timeout' in ms. - */ -void -set_timer(Process* p, Uint timeout) -{ - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); - - /* check for special case timeout=0 DONT ADD TO time queue */ - if (timeout == 0) { - p->flags |= F_TIMO; - return; - } - p->flags |= F_INSLPQUEUE; - p->flags &= ~F_TIMO; - -#ifdef ERTS_SMP - erts_create_smp_ptimer(&p->common.u.alive.ptimer, - p->common.id, - (ErlTimeoutProc) timeout_proc, - timeout); -#else - erts_set_timer(&p->common.u.alive.tm, - (ErlTimeoutProc) timeout_proc, - NULL, - (void*) p, - timeout); -#endif -} - /* * Stack dump functions follow. */ @@ -12432,6 +12439,10 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "FIX_ALLOC_LOWER_LIM"); break; case ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP: erts_print(to, to_arg, "THR_PRGR_LATER_OP"); break; + case ERTS_SSI_AUX_WORK_CNCLD_TMRS: + erts_print(to, to_arg, "CANCELED_TIMERS"); break; + case ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR: + erts_print(to, to_arg, "CANCELED_TIMERS_THR_PRGR"); break; case ERTS_SSI_AUX_WORK_ASYNC_READY: erts_print(to, to_arg, "ASYNC_READY"); break; case ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN: diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 743711cc3b..b1c30e7652 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -52,7 +52,7 @@ typedef struct process Process; #include "erl_node_container_utils.h" #include "erl_node_tables.h" #include "erl_monitors.h" -#include "erl_bif_timer.h" +#include "erl_hl_timer.h" #include "erl_time.h" #include "erl_atom_table.h" #include "external.h" @@ -278,16 +278,18 @@ typedef enum { #define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 3) #define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4) #define ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP (((erts_aint32_t) 1) << 5) -#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 6) -#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 7) -#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 8) -#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 9) -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 10) -#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 11) -#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 12) -#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 13) - -#define ERTS_SSI_AUX_WORK_MAX 14 +#define ERTS_SSI_AUX_WORK_CNCLD_TMRS (((erts_aint32_t) 1) << 6) +#define ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR (((erts_aint32_t) 1) << 7) +#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 8) +#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 9) +#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 10) +#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 11) +#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 12) +#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 13) +#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 14) +#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 15) + +#define ERTS_SSI_AUX_WORK_MAX 16 typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; @@ -463,19 +465,21 @@ typedef union { extern ErtsAlignedRunQueue *erts_aligned_run_queues; -#define ERTS_PROC_REDUCTIONS_EXECUTED(RQ, PRIO, REDS, AREDS) \ +#define ERTS_PROC_REDUCTIONS_EXECUTED(SD, RQ, PRIO, REDS, AREDS)\ do { \ (RQ)->procs.reductions += (AREDS); \ (RQ)->procs.prio_info[(PRIO)].reds += (REDS); \ (RQ)->check_balance_reds -= (REDS); \ (RQ)->wakeup_other_reds += (AREDS); \ + (SD)->check_time_reds += (AREDS); \ } while (0) -#define ERTS_PORT_REDUCTIONS_EXECUTED(RQ, REDS) \ +#define ERTS_PORT_REDUCTIONS_EXECUTED(SD, RQ, REDS) \ do { \ (RQ)->ports.info.reds += (REDS); \ (RQ)->check_balance_reds -= (REDS); \ (RQ)->wakeup_other_reds += (REDS); \ + (SD)->check_time_reds += (REDS); \ } while (0) typedef struct { @@ -516,6 +520,9 @@ typedef struct { } dd; struct { ErtsThrPrgrVal thr_prgr; + } cncld_tmrs; + struct { + ErtsThrPrgrVal thr_prgr; UWord size; ErtsThrPrgrLaterOp *first; ErtsThrPrgrLaterOp *last; @@ -566,6 +573,7 @@ struct ErtsSchedulerData_ { ErtsTimerWheel *timer_wheel; ErtsNextTimeoutRef next_tmo_ref; + ErtsHLTimerService *timer_service; #ifdef ERTS_SMP ethr_tid tid; /* Thread id */ struct erl_bits_state erl_bits_state; /* erl_bits.c state */ @@ -592,6 +600,9 @@ struct ErtsSchedulerData_ { ErtsAuxWorkData aux_work_data; ErtsAtomCacheMap atom_cache_map; + ErtsMonotonicTime last_monotonic_time; + int check_time_reds; + Uint32 thr_id; Uint64 unique; Uint64 ref; @@ -913,10 +924,8 @@ struct process { ErlMessageQueue msg; /* Message queue */ - union { - ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ - void *terminate; - } u; + ErtsBifTimers *bif_timers; /* Bif timers aiming at this process */ + ErtsBifTimers *accessor_bif_timers; /* Accessor bif timers */ ProcDict *dictionary; /* Process dictionary, may be NULL */ @@ -927,9 +936,12 @@ struct process { #ifdef USE_VM_PROBES Eterm dt_utag; /* Place to store the dynamc trace user tag */ Uint dt_utag_flags; /* flag field for the dt_utag */ -#endif - BeamInstr initial[3]; /* Initial module(0), function(1), arity(2), often used instead +#endif + union { + void *terminate; + BeamInstr initial[3]; /* Initial module(0), function(1), arity(2), often used instead of pointer to funcinfo instruction, hence the BeamInstr datatype */ + } u; BeamInstr* current; /* Current Erlang function, part of the funcinfo: * module(0), function(1), arity(2) * (module and functions are tagged atoms; @@ -975,7 +987,6 @@ struct process { ErtsSchedulerData *scheduler_data; Eterm suspendee; ErtsPendingSuspend *pending_suspenders; - ErtsRunQueue *preferred_run_queue; erts_smp_atomic_t run_queue; #ifdef HIPE struct hipe_process_state_smp hipe_smp; @@ -1085,15 +1096,14 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15) #define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16) #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) -#define ERTS_PSFLG_OFF_HEAP_MSGS ERTS_PSFLG_BIT(18) #ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(19) -#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(20) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(21) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(22) -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 23) +#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18) +#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19) +#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20) +#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22) #else -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 19) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18) #endif #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ @@ -1112,7 +1122,6 @@ void erts_check_for_holes(Process* p); * Static flags that do not change after process creation. */ #define ERTS_STC_FLG_SYSTEM_PROC (((Uint32) 1) << 0) -#define ERTS_STC_FLG_PREFER_SCHED (((Uint32) 1) << 1) /* The sequential tracing token is a tuple of size 5: * @@ -1141,9 +1150,7 @@ void erts_check_for_holes(Process* p); #define SPO_LINK 1 #define SPO_USE_ARGS 2 #define SPO_MONITOR 4 -#define SPO_OFF_HEAP_MSGS 8 -#define SPO_SYSTEM_PROC 16 -#define SPO_PREFER_SCHED 32 +#define SPO_SYSTEM_PROC 8 /* * The following struct contains options for a process to be spawned. @@ -1231,7 +1238,6 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC */ -#define F_OFF_HEAP_MSGS (1 << 12) /* process trace_flags */ #define F_SENSITIVE (1 << 0) @@ -1267,8 +1273,6 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; # define F_INITIAL_TRACE_FLAGS 0 #endif - - #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 \ @@ -1302,12 +1306,14 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define ERTS_XSIG_FLG_IGN_KILL (((Uint32) 1) << 0) #define ERTS_XSIG_FLG_NO_IGN_NORMAL (((Uint32) 1) << 1) -#define CANCEL_TIMER(p) \ - do { \ - if ((p)->flags & (F_INSLPQUEUE)) \ - cancel_timer(p); \ - else \ - (p)->flags &= ~F_TIMO; \ +#define CANCEL_TIMER(P) \ + do { \ + if ((P)->flags & (F_INSLPQUEUE|F_TIMO)) { \ + if ((P)->flags & F_INSLPQUEUE) \ + erts_cancel_proc_timer((P)); \ + else \ + (P)->flags &= ~F_TIMO; \ + } \ } while (0) #if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP) @@ -1594,6 +1600,9 @@ Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); void erts_alloc_notify_delayed_dealloc(int); void erts_alloc_ensure_handle_delayed_dealloc_call(int); +#ifdef ERTS_SMP +void erts_notify_canceled_timer(ErtsSchedulerData *, int); +#endif void erts_smp_notify_check_children_needed(void); #endif #if ERTS_USE_ASYNC_READY_Q @@ -1628,8 +1637,6 @@ void erts_schedule_misc_op(void (*)(void *), void *); Eterm erl_create_process(Process*, Eterm, Eterm, Eterm, ErlSpawnOpts*); void erts_do_exit_process(Process*, Eterm); void erts_continue_exit_process(Process *); -void set_timer(Process*, Uint); -void cancel_timer(Process*); /* Begin System profile */ Uint erts_runnable_process_count(void); /* End System profile */ diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 82cc68222d..fff267ff2a 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -103,6 +103,7 @@ static struct { Sint16 proc_lock_main; Sint16 proc_lock_link; Sint16 proc_lock_msgq; + Sint16 proc_lock_btm; Sint16 proc_lock_status; } lc_id; #endif @@ -145,6 +146,7 @@ erts_init_proc_lock(int cpus) lc_id.proc_lock_main = erts_lc_get_lock_order_id("proc_main"); lc_id.proc_lock_link = erts_lc_get_lock_order_id("proc_link"); lc_id.proc_lock_msgq = erts_lc_get_lock_order_id("proc_msgq"); + lc_id.proc_lock_btm = erts_lc_get_lock_order_id("proc_btm"); lc_id.proc_lock_status = erts_lc_get_lock_order_id("proc_status"); #endif } @@ -707,7 +709,7 @@ proc_safelock(int is_managed, need_locks1 |= unlock_locks; if (!is_managed && !have_locks1) { refc1 = 1; - erts_smp_proc_inc_refc(p1); + erts_proc_inc_refc(p1); } erts_smp_proc_unlock(p1, unlock_locks); } @@ -717,7 +719,7 @@ proc_safelock(int is_managed, need_locks2 |= unlock_locks; if (!is_managed && !have_locks2) { refc2 = 1; - erts_smp_proc_inc_refc(p2); + erts_proc_inc_refc(p2); } erts_smp_proc_unlock(p2, unlock_locks); } @@ -798,9 +800,9 @@ proc_safelock(int is_managed, if (!is_managed) { if (refc1) - erts_smp_proc_dec_refc(p1); + erts_proc_dec_refc(p1); if (refc2) - erts_smp_proc_dec_refc(p2); + erts_proc_dec_refc(p2); } } @@ -861,8 +863,8 @@ erts_pid2proc_opt(Process *c_p, return NULL; need_locks &= ~c_p_have_locks; if (!need_locks) { - if (flags & ERTS_P2P_FLG_SMP_INC_REFC) - erts_smp_proc_inc_refc(c_p); + if (flags & ERTS_P2P_FLG_INC_REFC) + erts_proc_inc_refc(c_p); return c_p; } } @@ -875,8 +877,8 @@ erts_pid2proc_opt(Process *c_p, if (proc->common.id != pid) proc = NULL; else if (!need_locks) { - if (flags & ERTS_P2P_FLG_SMP_INC_REFC) - erts_smp_proc_inc_refc(proc); + if (flags & ERTS_P2P_FLG_INC_REFC) + erts_proc_inc_refc(proc); } else { int busy; @@ -916,8 +918,8 @@ erts_pid2proc_opt(Process *c_p, #endif if (!busy) { - if (flags & ERTS_P2P_FLG_SMP_INC_REFC) - erts_smp_proc_inc_refc(proc); + if (flags & ERTS_P2P_FLG_INC_REFC) + erts_proc_inc_refc(proc); #if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT) /* all is great */ @@ -932,8 +934,8 @@ erts_pid2proc_opt(Process *c_p, proc = ERTS_PROC_LOCK_BUSY; else { int managed; - if (flags & ERTS_P2P_FLG_SMP_INC_REFC) - erts_smp_proc_inc_refc(proc); + if (flags & ERTS_P2P_FLG_INC_REFC) + erts_proc_inc_refc(proc); #if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT) erts_lcnt_proc_lock_unaquire(&proc->lock, lcnt_locks); @@ -941,7 +943,7 @@ erts_pid2proc_opt(Process *c_p, managed = dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED; if (!managed) { - erts_smp_proc_inc_refc(proc); + erts_proc_inc_refc(proc); erts_thr_progress_unmanaged_continue(dhndl); dec_refc_proc = proc; @@ -978,14 +980,14 @@ erts_pid2proc_opt(Process *c_p, erts_smp_proc_unlock(proc, need_locks); - if (flags & ERTS_P2P_FLG_SMP_INC_REFC) + if (flags & ERTS_P2P_FLG_INC_REFC) dec_refc_proc = proc; proc = NULL; } if (dec_refc_proc) - erts_smp_proc_dec_refc(dec_refc_proc); + erts_proc_dec_refc(dec_refc_proc); #if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_PROC_LOCK_DEBUG) ERTS_LC_ASSERT(!proc @@ -1038,6 +1040,11 @@ erts_proc_lock_init(Process *p) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.msgq.lc); #endif + erts_mtx_init_x(&p->lock.btm, "proc_btm", p->common.id, do_lock_count); + ethr_mutex_lock(&p->lock.btm.mtx); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(1, &p->lock.btm.lc); +#endif erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id, do_lock_count); ethr_mutex_lock(&p->lock.status.mtx); @@ -1045,7 +1052,6 @@ erts_proc_lock_init(Process *p) erts_lc_trylock(1, &p->lock.status.lc); #endif #endif - erts_atomic32_init_nob(&p->lock.refc, 1); #ifdef ERTS_PROC_LOCK_DEBUG for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) erts_smp_atomic32_init_nob(&p->lock.locked[i], (erts_aint32_t) 1); @@ -1064,6 +1070,7 @@ erts_proc_lock_fin(Process *p) erts_mtx_destroy(&p->lock.main); erts_mtx_destroy(&p->lock.link); erts_mtx_destroy(&p->lock.msgq); + erts_mtx_destroy(&p->lock.btm); erts_mtx_destroy(&p->lock.status); #endif #if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) @@ -1079,17 +1086,20 @@ void erts_lcnt_proc_lock_init(Process *p) { if (p->common.id != ERTS_INVALID_PID) { erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, p->common.id); erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, p->common.id); + erts_lcnt_init_lock_x(&(p->lock.lcnt_btm), "proc_btm", ERTS_LCNT_LT_PROCLOCK, p->common.id); erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, p->common.id); erts_lcnt_init_lock_x(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK, p->common.id); } else { erts_lcnt_init_lock(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK); erts_lcnt_init_lock(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK); + erts_lcnt_init_lock(&(p->lock.lcnt_btm), "proc_btm", ERTS_LCNT_LT_PROCLOCK); erts_lcnt_init_lock(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK); erts_lcnt_init_lock(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK); } } else { sys_memzero(&(p->lock.lcnt_main), sizeof(p->lock.lcnt_main)); sys_memzero(&(p->lock.lcnt_msgq), sizeof(p->lock.lcnt_msgq)); + sys_memzero(&(p->lock.lcnt_btm), sizeof(p->lock.lcnt_btm)); sys_memzero(&(p->lock.lcnt_link), sizeof(p->lock.lcnt_link)); sys_memzero(&(p->lock.lcnt_status), sizeof(p->lock.lcnt_status)); } @@ -1099,6 +1109,7 @@ void erts_lcnt_proc_lock_init(Process *p) { void erts_lcnt_proc_lock_destroy(Process *p) { erts_lcnt_destroy_lock(&(p->lock.lcnt_main)); erts_lcnt_destroy_lock(&(p->lock.lcnt_msgq)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_btm)); erts_lcnt_destroy_lock(&(p->lock.lcnt_link)); erts_lcnt_destroy_lock(&(p->lock.lcnt_status)); } @@ -1111,6 +1122,9 @@ void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock(&(lock->lcnt_msgq)); } + if (locks & ERTS_PROC_LOCK_BTM) { + erts_lcnt_lock(&(lock->lcnt_btm)); + } if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock(&(lock->lcnt_link)); } @@ -1128,6 +1142,9 @@ void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, cha if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock_post_x(&(lock->lcnt_msgq), file, line); } + if (locks & ERTS_PROC_LOCK_BTM) { + erts_lcnt_lock_post_x(&(lock->lcnt_btm), file, line); + } if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line); } @@ -1145,6 +1162,9 @@ void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock_unaquire(&(lock->lcnt_msgq)); } + if (locks & ERTS_PROC_LOCK_BTM) { + erts_lcnt_lock_unaquire(&(lock->lcnt_btm)); + } if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_unaquire(&(lock->lcnt_link)); } @@ -1162,6 +1182,9 @@ void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_unlock(&(lock->lcnt_msgq)); } + if (locks & ERTS_PROC_LOCK_BTM) { + erts_lcnt_unlock(&(lock->lcnt_btm)); + } if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_unlock(&(lock->lcnt_link)); } @@ -1178,6 +1201,9 @@ void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_trylock(&(lock->lcnt_msgq), res); } + if (locks & ERTS_PROC_LOCK_BTM) { + erts_lcnt_trylock(&(lock->lcnt_btm), res); + } if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_trylock(&(lock->lcnt_link), res); } @@ -1235,6 +1261,10 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line lck.id = lc_id.proc_lock_msgq; erts_lc_lock_x(&lck,file,line); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_lock_x(&lck,file,line); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_lock_x(&lck,file,line); @@ -1260,6 +1290,10 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked, lck.id = lc_id.proc_lock_msgq; erts_lc_trylock_x(locked, &lck, file, line); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_trylock_x(locked, &lck, file, line); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_trylock_x(locked, &lck, file, line); @@ -1276,6 +1310,10 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_status; erts_lc_unlock(&lck); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; erts_lc_unlock(&lck); @@ -1303,6 +1341,10 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_status; erts_lc_might_unlock(&lck); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_might_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; erts_lc_might_unlock(&lck); @@ -1322,6 +1364,8 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) erts_lc_might_unlock(&p->lock.link.lc); if (locks & ERTS_PROC_LOCK_MSGQ) erts_lc_might_unlock(&p->lock.msgq.lc); + if (locks & ERTS_PROC_LOCK_BTM) + erts_lc_might_unlock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_might_unlock(&p->lock.status.lc); #endif @@ -1347,6 +1391,10 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, lck.id = lc_id.proc_lock_msgq; erts_lc_require_lock(&lck, file, line); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_require_lock(&lck, file, line); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_require_lock(&lck, file, line); @@ -1358,6 +1406,8 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, erts_lc_require_lock(&p->lock.link.lc, file, line); if (locks & ERTS_PROC_LOCK_MSGQ) erts_lc_require_lock(&p->lock.msgq.lc, file, line); + if (locks & ERTS_PROC_LOCK_BTM) + erts_lc_require_lock(&p->lock.btm.lc, file, line); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_require_lock(&p->lock.status.lc, file, line); #endif @@ -1374,6 +1424,10 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_status; erts_lc_unrequire_lock(&lck); } + if (locks & ERTS_PROC_LOCK_BTM) { + lck.id = lc_id.proc_lock_btm; + erts_lc_unrequire_lock(&lck); + } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; erts_lc_unrequire_lock(&lck); @@ -1393,6 +1447,8 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) erts_lc_unrequire_lock(&p->lock.link.lc); if (locks & ERTS_PROC_LOCK_MSGQ) erts_lc_unrequire_lock(&p->lock.msgq.lc); + if (locks & ERTS_PROC_LOCK_BTM) + erts_lc_unrequire_lock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_unrequire_lock(&p->lock.status.lc); #endif @@ -1414,6 +1470,8 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_link; else if (locks & ERTS_PROC_LOCK_MSGQ) lck.id = lc_id.proc_lock_msgq; + else if (locks & ERTS_PROC_LOCK_BTM) + lck.id = lc_id.proc_lock_btm; else if (locks & ERTS_PROC_LOCK_STATUS) lck.id = lc_id.proc_lock_status; else @@ -1448,7 +1506,8 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) { int have_locks_len = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; @@ -1464,18 +1523,24 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len].id = lc_id.proc_lock_msgq; have_locks[have_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_BTM) { + have_locks[have_locks_len].id = lc_id.proc_lock_btm; + have_locks[have_locks_len++].extra = p->common.id; + } if (locks & ERTS_PROC_LOCK_STATUS) { have_locks[have_locks_len].id = lc_id.proc_lock_status; have_locks[have_locks_len++].extra = p->common.id; } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[4]; + erts_lc_lock_t have_locks[5]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; if (locks & ERTS_PROC_LOCK_LINK) have_locks[have_locks_len++] = p->lock.link.lc; if (locks & ERTS_PROC_LOCK_MSGQ) have_locks[have_locks_len++] = p->lock.msgq.lc; + if (locks & ERTS_PROC_LOCK_BTM) + have_locks[have_locks_len++] = p->lock.btm.lc; if (locks & ERTS_PROC_LOCK_STATUS) have_locks[have_locks_len++] = p->lock.status.lc; #endif @@ -1488,11 +1553,11 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) int have_locks_len = 0; int have_not_locks_len = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; - erts_lc_lock_t have_not_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_not_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; @@ -1521,6 +1586,14 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_not_locks[have_not_locks_len].id = lc_id.proc_lock_msgq; have_not_locks[have_not_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_BTM) { + have_locks[have_locks_len].id = lc_id.proc_lock_btm; + have_locks[have_locks_len++].extra = p->common.id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_btm; + have_not_locks[have_not_locks_len++].extra = p->common.id; + } if (locks & ERTS_PROC_LOCK_STATUS) { have_locks[have_locks_len].id = lc_id.proc_lock_status; have_locks[have_locks_len++].extra = p->common.id; @@ -1530,8 +1603,8 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_not_locks[have_not_locks_len++].extra = p->common.id; } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[4]; - erts_lc_lock_t have_not_locks[4]; + erts_lc_lock_t have_locks[5]; + erts_lc_lock_t have_not_locks[5]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; @@ -1545,6 +1618,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len++] = p->lock.msgq.lc; else have_not_locks[have_not_locks_len++] = p->lock.msgq.lc; + if (locks & ERTS_PROC_LOCK_BTM) + have_locks[have_locks_len++] = p->lock.btm.lc; + else + have_not_locks[have_not_locks_len++] = p->lock.btm.lc; if (locks & ERTS_PROC_LOCK_STATUS) have_locks[have_locks_len++] = p->lock.status.lc; else @@ -1558,10 +1635,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p) { - int resv[4]; + int resv[5]; ErtsProcLocks res = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t locks[4] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, + erts_lc_lock_t locks[5] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, p->common.id, ERTS_LC_FLG_LT_PROCLOCK), ERTS_LC_LOCK_INIT(lc_id.proc_lock_link, @@ -1570,17 +1647,21 @@ erts_proc_lc_my_proc_locks(Process *p) ERTS_LC_LOCK_INIT(lc_id.proc_lock_msgq, p->common.id, ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_btm, + p->common.id, + ERTS_LC_FLG_LT_PROCLOCK), ERTS_LC_LOCK_INIT(lc_id.proc_lock_status, p->common.id, ERTS_LC_FLG_LT_PROCLOCK)}; #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t locks[4] = {p->lock.main.lc, + erts_lc_lock_t locks[5] = {p->lock.main.lc, p->lock.link.lc, p->lock.msgq.lc, + p->lock.btm.lc, p->lock.status.lc}; #endif - erts_lc_have_locks(resv, locks, 4); + erts_lc_have_locks(resv, locks, 5); if (resv[0]) res |= ERTS_PROC_LOCK_MAIN; if (resv[1]) @@ -1588,6 +1669,8 @@ erts_proc_lc_my_proc_locks(Process *p) if (resv[2]) res |= ERTS_PROC_LOCK_MSGQ; if (resv[3]) + res |= ERTS_PROC_LOCK_BTM; + if (resv[4]) res |= ERTS_PROC_LOCK_STATUS; return res; @@ -1596,13 +1679,14 @@ erts_proc_lc_my_proc_locks(Process *p) void erts_proc_lc_chk_no_proc_locks(char *file, int line) { - int resv[4]; - int ids[4] = {lc_id.proc_lock_main, + int resv[5]; + int ids[5] = {lc_id.proc_lock_main, lc_id.proc_lock_link, lc_id.proc_lock_msgq, + lc_id.proc_lock_btm, lc_id.proc_lock_status}; - erts_lc_have_lock_ids(resv, ids, 4); - if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3])) { + erts_lc_have_lock_ids(resv, ids, 5); + if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4])) { erts_lc_fail("%s:%d: Thread has process locks locked when expected " "not to have any process locks locked", file, line); diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 052d992d3f..8957e7773b 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -65,7 +65,7 @@ #endif -#define ERTS_PROC_LOCK_MAX_BIT 3 +#define ERTS_PROC_LOCK_MAX_BIT 4 typedef erts_aint32_t ErtsProcLocks; @@ -81,17 +81,18 @@ typedef struct erts_proc_lock_t_ { erts_lcnt_lock_t lcnt_main; erts_lcnt_lock_t lcnt_link; erts_lcnt_lock_t lcnt_msgq; + erts_lcnt_lock_t lcnt_btm; erts_lcnt_lock_t lcnt_status; #endif #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL erts_mtx_t main; erts_mtx_t link; erts_mtx_t msgq; + erts_mtx_t btm; erts_mtx_t status; #else # error "no implementation" #endif - erts_atomic32_t refc; #ifdef ERTS_PROC_LOCK_DEBUG erts_smp_atomic32_t locked[ERTS_PROC_LOCK_MAX_BIT+1]; #endif @@ -120,11 +121,17 @@ typedef struct erts_proc_lock_t_ { * Message queue lock: * Protects the following fields in the process structure: * * msg_inq - * * bif_timers */ #define ERTS_PROC_LOCK_MSGQ (((ErtsProcLocks) 1) << 2) /* + * Bif timer lock: + * Protects the following fields in the process structure: + * * bif_timers + */ +#define ERTS_PROC_LOCK_BTM (((ErtsProcLocks) 1) << 3) + +/* * Status lock: * Protects the following fields in the process structure: * * pending_suspenders @@ -463,6 +470,9 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks) if (locks & ERTS_PROC_LOCK_MSGQ) if (erts_mtx_trylock(&p->lock.msgq) == EBUSY) goto busy_msgq; + if (locks & ERTS_PROC_LOCK_BTM) + if (erts_mtx_trylock(&p->lock.btm) == EBUSY) + goto busy_btm; if (locks & ERTS_PROC_LOCK_STATUS) if (erts_mtx_trylock(&p->lock.status) == EBUSY) goto busy_status; @@ -470,6 +480,9 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks) return 0; busy_status: + if (locks & ERTS_PROC_LOCK_BTM) + erts_mtx_unlock(&p->lock.btm); +busy_btm: if (locks & ERTS_PROC_LOCK_MSGQ) erts_mtx_unlock(&p->lock.msgq); busy_msgq: @@ -549,6 +562,8 @@ erts_smp_proc_lock__(Process *p, erts_mtx_lock(&p->lock.link); if (locks & ERTS_PROC_LOCK_MSGQ) erts_mtx_lock(&p->lock.msgq); + if (locks & ERTS_PROC_LOCK_BTM) + erts_mtx_lock(&p->lock.btm); if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_lock(&p->lock.status); @@ -638,6 +653,8 @@ erts_smp_proc_unlock__(Process *p, if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_unlock(&p->lock.status); + if (locks & ERTS_PROC_LOCK_BTM) + erts_mtx_unlock(&p->lock.btm); if (locks & ERTS_PROC_LOCK_MSGQ) erts_mtx_unlock(&p->lock.msgq); if (locks & ERTS_PROC_LOCK_LINK) @@ -752,9 +769,10 @@ ERTS_GLB_INLINE void erts_smp_proc_lock(Process *, ErtsProcLocks); ERTS_GLB_INLINE void erts_smp_proc_unlock(Process *, ErtsProcLocks); ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks); -ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *); -ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *); -ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *, Sint32); +ERTS_GLB_INLINE void erts_proc_inc_refc(Process *); +ERTS_GLB_INLINE void erts_proc_dec_refc(Process *); +ERTS_GLB_INLINE void erts_proc_add_refc(Process *, Sint); +ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -814,28 +832,59 @@ erts_smp_proc_trylock(Process *p, ErtsProcLocks locks) #endif } -ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *p) +ERTS_GLB_INLINE void erts_proc_inc_refc(Process *p) { + ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY)); #ifdef ERTS_SMP + erts_ptab_atmc_inc_refc(&p->common); +#else erts_ptab_inc_refc(&p->common); #endif } -ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *p) +ERTS_GLB_INLINE void erts_proc_dec_refc(Process *p) { + Sint referred; + ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY)); #ifdef ERTS_SMP - int referred = erts_ptab_dec_test_refc(&p->common); - if (!referred) - erts_free_proc(p); + referred = erts_ptab_atmc_dec_test_refc(&p->common); +#else + referred = erts_ptab_dec_test_refc(&p->common); #endif + if (!referred) { + ASSERT(ERTS_PROC_IS_EXITING(p)); + ASSERT(ERTS_AINT_NULL + == erts_ptab_pix2intptr_ddrb(&erts_proc, + internal_pid_index(p->common.id))); + erts_free_proc(p); + } } -ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *p, Sint32 add_refc) +ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc) { + Sint referred; + ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY)); #ifdef ERTS_SMP - int referred = erts_ptab_add_test_refc(&p->common, add_refc); - if (!referred) + referred = erts_ptab_atmc_add_test_refc(&p->common, add_refc); +#else + referred = erts_ptab_add_test_refc(&p->common, add_refc); +#endif + if (!referred) { + ASSERT(ERTS_PROC_IS_EXITING(p)); + ASSERT(ERTS_AINT_NULL + == erts_ptab_pix2intptr_ddrb(&erts_proc, + internal_pid_index(p->common.id))); erts_free_proc(p); + } +} + +ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *p) +{ + ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY)); +#ifdef ERTS_SMP + return erts_ptab_atmc_read_refc(&p->common); +#else + return erts_ptab_read_refc(&p->common); #endif } @@ -868,7 +917,7 @@ void erts_proc_safelock(Process *a_proc, #define ERTS_P2P_FLG_ALLOW_OTHER_X (1 << 0) #define ERTS_P2P_FLG_TRY_LOCK (1 << 1) -#define ERTS_P2P_FLG_SMP_INC_REFC (1 << 2) +#define ERTS_P2P_FLG_INC_REFC (1 << 2) #define ERTS_PROC_LOCK_BUSY ((Process *) &erts_invalid_process) @@ -928,11 +977,14 @@ erts_pid2proc_opt(Process *c_p_unused, int flags) { Process *proc = erts_proc_lookup_raw(pid); - return ((!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X) - && proc - && ERTS_PROC_IS_EXITING(proc)) - ? NULL - : proc); + if (!proc) + return NULL; + if (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X) + && ERTS_PROC_IS_EXITING(proc)) + return NULL; + if (flags & ERTS_P2P_FLG_INC_REFC) + erts_proc_inc_refc(proc); + return proc; } #endif /* !ERTS_SMP */ diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index 02943ee683..c688db98d8 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -360,7 +360,8 @@ erts_ptab_init_table(ErtsPTab *ptab, int size, UWord element_size, char *name, - int legacy) + int legacy, + int atomic_refc) { size_t tab_sz, alloc_sz; Uint32 bits, cl, cli, ix, ix_per_cache_line, tab_cache_lines; @@ -415,6 +416,8 @@ erts_ptab_init_table(ErtsPTab *ptab, ptab->r.o.invalid_data = erts_ptab_id2data(ptab, invalid_element->id); ptab->r.o.release_element = release_element; + ptab->r.o.atomic_refc = atomic_refc; + if (legacy) { ptab->r.o.free_id_data = NULL; ptab->r.o.dix_cl_mask = 0; @@ -533,9 +536,10 @@ erts_ptab_new_element(ErtsPTab *ptab, init_ptab_el(init_arg, (Eterm) data); -#ifdef ERTS_SMP - erts_smp_atomic32_init_nob(&ptab_el->refc, 1); -#endif + if (ptab->r.o.atomic_refc) + erts_atomic_init_nob(&ptab_el->refc.atmc, 1); + else + ptab_el->refc.sint = 1; pix = erts_ptab_data2pix(ptab, (Eterm) data); @@ -608,9 +612,10 @@ erts_ptab_new_element(ErtsPTab *ptab, init_ptab_el(init_arg, data); -#ifdef ERTS_SMP - erts_smp_atomic32_init_nob(&ptab_el->refc, 1); -#endif + if (ptab->r.o.atomic_refc) + erts_atomic_init_nob(&ptab_el->refc.atmc, 1); + else + ptab_el->refc.sint = 1; /* Move into slot reserved */ #ifdef DEBUG diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index 876241159b..102d41e07f 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -51,11 +51,13 @@ typedef struct { Eterm id; -#ifdef ERTS_SMP - erts_atomic32_t refc; -#endif + union { + erts_atomic_t atmc; + Sint sint; + } refc; Eterm tracer_proc; Uint trace_flags; + erts_smp_atomic_t timer; union { /* --- While being alive --- */ struct { @@ -63,11 +65,6 @@ typedef struct { struct reg_proc *reg; ErtsLink *links; ErtsMonitor *monitors; -#ifdef ERTS_SMP - ErtsSmpPTimer *ptimer; -#else - ErlTimer tm; -#endif } alive; /* --- While being released --- */ @@ -111,6 +108,7 @@ typedef struct { Eterm invalid_data; void (*release_element)(void *); UWord element_size; + int atomic_refc; } ErtsPTabReadOnlyData; typedef struct { @@ -181,7 +179,8 @@ void erts_ptab_init_table(ErtsPTab *ptab, int size, UWord element_size, char *name, - int legacy); + int legacy, + int atomic_refc); int erts_ptab_new_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el, void *init_arg, @@ -206,9 +205,15 @@ ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_ddrb(ErtsPTab *ptab, int ix); ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_rb(ErtsPTab *ptab, int ix); ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_acqb(ErtsPTab *ptab, int ix); ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el); -ERTS_GLB_INLINE int erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el); -ERTS_GLB_INLINE int erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el, - Sint32 add_refc); +ERTS_GLB_INLINE Sint erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el); +ERTS_GLB_INLINE Sint erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el, + Sint add_refc); +ERTS_GLB_INLINE Sint erts_ptab_read_refc(ErtsPTabElementCommon *ptab_el); +ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el); +ERTS_GLB_INLINE Sint erts_ptab_atmc_dec_test_refc(ErtsPTabElementCommon *ptab_el); +ERTS_GLB_INLINE Sint erts_ptab_atmc_add_test_refc(ErtsPTabElementCommon *ptab_el, + Sint add_refc); +ERTS_GLB_INLINE Sint erts_ptab_atmc_read_refc(ErtsPTabElementCommon *ptab_el); ERTS_GLB_INLINE void erts_ptab_rlock(ErtsPTab *ptab); ERTS_GLB_INLINE int erts_ptab_tryrlock(ErtsPTab *ptab); ERTS_GLB_INLINE void erts_ptab_runlock(ErtsPTab *ptab); @@ -365,50 +370,65 @@ ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_acqb(ErtsPTab *ptab, int ix) return erts_smp_atomic_read_acqb(&ptab->r.o.tab[ix]); } -ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el) +ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el) { -#ifdef ERTS_SMP #ifdef ERTS_ENABLE_LOCK_CHECK - erts_aint32_t refc = erts_atomic32_inc_read_nob(&ptab_el->refc); - ERTS_SMP_LC_ASSERT(refc > 1); + erts_aint_t refc = erts_atomic_inc_read_nob(&ptab_el->refc.atmc); + ERTS_LC_ASSERT(refc > 1); #else - erts_atomic32_inc_nob(&ptab_el->refc); -#endif + erts_atomic_inc_nob(&ptab_el->refc.atmc); #endif } -ERTS_GLB_INLINE int erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el) +ERTS_GLB_INLINE Sint erts_ptab_atmc_dec_test_refc(ErtsPTabElementCommon *ptab_el) { -#ifdef ERTS_SMP - erts_aint32_t refc = erts_atomic32_dec_read_nob(&ptab_el->refc); + erts_aint_t refc = erts_atomic_dec_read_relb(&ptab_el->refc.atmc); ERTS_SMP_LC_ASSERT(refc >= 0); - return (int) refc; -#else - return 0; +#ifdef ERTS_SMP + if (refc == 0) + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); #endif + return (Sint) refc; } -ERTS_GLB_INLINE int erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el, - Sint32 add_refc) +ERTS_GLB_INLINE Sint erts_ptab_atmc_add_test_refc(ErtsPTabElementCommon *ptab_el, + Sint add_refc) { -#ifdef ERTS_SMP - erts_aint32_t refc; + erts_aint_t refc = erts_atomic_add_read_mb(&ptab_el->refc.atmc, + (erts_aint_t) add_refc); + ERTS_SMP_LC_ASSERT(refc >= 0); + return (Sint) refc; +} -#ifndef ERTS_ENABLE_LOCK_CHECK - if (add_refc >= 0) { - erts_atomic32_add_nob(&ptab_el->refc, - (erts_aint32_t) add_refc); - return 1; - } -#endif +ERTS_GLB_INLINE Sint erts_ptab_atmc_read_refc(ErtsPTabElementCommon *ptab_el) +{ + return (Sint) erts_atomic_read_nob(&ptab_el->refc.atmc); +} + +ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el) +{ + ptab_el->refc.sint++; + ASSERT(ptab_el->refc.sint > 1); +} - refc = erts_atomic32_add_read_nob(&ptab_el->refc, - (erts_aint32_t) add_refc); +ERTS_GLB_INLINE Sint erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el) +{ + Sint refc = --ptab_el->refc.sint; ERTS_SMP_LC_ASSERT(refc >= 0); - return (int) refc; -#else - return 0; -#endif + return refc; +} + +ERTS_GLB_INLINE Sint erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el, + Sint add_refc) +{ + ptab_el->refc.sint += add_refc; + ERTS_SMP_LC_ASSERT(ptab_el->refc.sint >= 0); + return (Sint) ptab_el->refc.sint; +} + +ERTS_GLB_INLINE Sint erts_ptab_read_refc(ErtsPTabElementCommon *ptab_el) +{ + return ptab_el->refc.sint; } ERTS_GLB_INLINE void erts_ptab_rlock(ErtsPTab *ptab) diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h new file mode 100644 index 0000000000..ea0a8976bb --- /dev/null +++ b/erts/emulator/beam/erl_rbtree.h @@ -0,0 +1,1740 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A Red-Black (binary search) Tree implementation. The search, + * insert, and delete operations are all O(log n) operations + * on a Red-Black Tree. Red-Black Trees are described in + * "Introduction to Algorithms", by Thomas H. Cormen, Charles + * E. Leiserson, and Ronald L. Riverest. + * + * Use by defining mandatory defines as well as defines for + * API functions wanted, and include this header. + * + * Author: Rickard Green + * + * + * Mandatory defines: + * - ERTS_RBT_PREFIX - Prefix to use on functions. + * - ERTS_RBT_T - Type of a tree node. + * - ERTS_RBT_KEY_T - Type of key for a tree node. + * - ERTS_RBT_FLAGS_T - Type of flags for a tree node. + * - ERTS_RBT_INIT_EMPTY_TNODE(T) -Initialize an empty tree node. + * - ERTS_RBT_IS_RED(T) - Is tree node red? + * - ERTS_RBT_SET_RED(T) - Set tree node red. + * - ERTS_RBT_IS_BLACK(T) - Is tree node back? + * - ERTS_RBT_SET_BLACK(T) - Set tree node black. + * - ERTS_RBT_GET_FLAGS(T) - Get flags of tree node (incl colors). + * - ERTS_RBT_SET_FLAGS(T, F) - Set flags of tree note. + * - ERTS_RBT_GET_PARENT(T) - Get parent node. + * - ERTS_RBT_SET_PARENT(T, P) - Set parent node. + * - ERTS_RBT_GET_RIGHT(T) - Get right child node. + * - ERTS_RBT_SET_RIGHT(T, R) - Set right child node. + * - ERTS_RBT_GET_LEFT(T) - Get left child node. + * - ERTS_RBT_SET_LEFT(T, L) - Set left child node. + * - ERTS_RBT_GET_KEY(T) - Get key of node. + * - ERTS_RBT_IS_LT(KX, KY) - Is key KX less than key KY? + * - ERTS_RBT_IS_EQ(KX, KY) - Is key KX equal to key KY? + * + * Optional defines: + * + * - ERTS_RBT_UNDEF - Undefine all user defined ERTS_RBT_* + * defines after use. + * + * - ERTS_RBT_NO_API_INLINE - Do not inline API functions. + * + * Attached data management: + * - ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(L, OP, NP) - Called + * when a rotate operation has been performed. If L (in int) + * is a non zero, a left rotation was performed; otherwise, + * a right rotation was performed. OR points to the old + * parent node and NP points to the new parent node. + * - ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(F, T) - Called when + * a delete operation modifies a tree node. A delete + * modification is either a removal or replacement of a + * node. F points to the parent of the tree node that was + * modified. T points to the next ancestor that will be + * modified. If T is NULL, no more removal and/or + * replacements will be made. One typically wants to update + * the attached data of each node between F and T. If T is + * NULL all the way up to the root. + * - ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(OR, NR) - Called + * when the root node changes. OR points to the old + * root node and NP points to the new root node. + * + * Request implementation of API functions: + * - ERTS_RBT_WANT_DELETE + * - ERTS_RBT_WANT_INSERT + * - ERTS_RBT_WANT_LOOKUP_INSERT + * - ERTS_RBT_WANT_REPLACE + * - ERTS_RBT_WANT_LOOKUP + * - ERTS_RBT_WANT_SMALLEST + * - ERTS_RBT_WANT_LARGEST + * - ERTS_RBT_WANT_FOREACH + * - ERTS_RBT_WANT_FOREACH_DESTROY + * - ERTS_RBT_WANT_FOREACH_YIELDING + * - ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING + * - ERTS_RBT_WANT_FOREACH_SMALL + * - ERTS_RBT_WANT_FOREACH_LARGE + * - ERTS_RBT_WANT_FOREACH_SMALL_DESTROY + * - ERTS_RBT_WANT_FOREACH_LARGE_DESTROY + * - ERTS_RBT_WANT_FOREACH_SMALL_YIELDING + * - ERTS_RBT_WANT_FOREACH_LARGE_YIELDING + * - ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING + * - ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING + * - ERTS_RBT_WANT_DEBUG_PRINT + * + * The yield state data type will equal + * <ERTS_RBT_PREFIX>_rbt_yield_state_t. + * + * The yield state should be statically initialized by + * ERTS_RBT_YIELD_STAT_INITER. + * + * + * The following API functions are implemented if corresponding + * ERTS_RBT_WANT_<OPERATION> is defined: + * + * - void <ERTS_RBT_PREFIX>_rbt_delete( + * ERTS_RBT_T **tree, + * ERTS_RBT_T *element); + * Delete element from tree. + * + * - void <ERTS_RBT_PREFIX>_rbt_insert( + * ERTS_RBT_T **tree, + * ERTS_RBT_T *element); + * Insert element into tree. + * + * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_lookup_insert( + * ERTS_RBT_T **tree, + * ERTS_RBT_T *element); + * Look up an element in the tree that compares as equal to the + * element passed as argument, and return the looked up element. + * If no element compared as equal, insert the element passed as + * argument into the tree, and return NULL. + * + * - void <ERTS_RBT_PREFIX>_rbt_replace( + * ERTS_RBT_T **tree, + * ERTS_RBT_T *old_element, + * ERTS_RBT_T *new_element); + * Replace old_element in the tree with new_element. Both elements + * *should* compare as equal. + * + * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_lookup( + * ERTS_RBT_T *tree, + * ERTS_RBT_KEY_T key); + * Look up an element with a key that compares as equal to + * the key passed as argument. + * + * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_smallest( + * ERTS_RBT_T *tree); + * Look up the element with the smallest key. + * + * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_largest( + * ERTS_RBT_T *tree); + * Look up the element with the largest key. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element. + * Order is undefined. + * + * 'arg' is passed as argument to 'op'. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach_destroy( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element. + * Order is undefined. Each element should be destroyed + * by 'op'. + * + * 'arg' is passed as argument to 'op'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_yielding( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element. + * Order is undefined. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. The tree should not be + * modified until all of it has been processed. + * + * 'arg' is passed as argument to 'op'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_destroy_yielding( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element. + * Order is undefined. Each element should be destroyed + * by 'op'. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. + * + * 'arg' is passed as argument to 'op'. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach_small( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element from + * smallest towards larger elements. + * + * 'arg' is passed as argument to 'op'. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach_large( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element from + * largest towards smaller elements. + * + * 'arg' is passed as argument to 'op'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_yielding( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element from + * smallest towards larger elements. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. The tree should not be + * modified until all of it has been processed. + * + * 'arg' is passed as argument to 'op'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_yielding( + * ERTS_RBT_T *tree, + * void (*op)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element from + * largest towards smaller elements. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. The tree should not be + * modified until all of it has been processed. + * + * 'arg' is passed as argument to 'op'. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy( + * ERTS_RBT_T **tree, + * void (*op)(ERTS_RBT_T *, void *), + * void (*destr)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element from + * smallest towards larger elements. + * + * Destroy elements by calling the destructor 'destr'. Elements + * are destroyed when not needed by the tree structure anymore. + * Note that elements are often *not* destroyed in another order + * than the order that the elements are operated on. + * + * 'arg' is passed as argument to 'op' and 'destroy'. + * + * - void <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy( + * ERTS_RBT_T **tree, + * void (*op)(ERTS_RBT_T *, void *), + * void (*destr)(ERTS_RBT_T *, void *), + * void *arg); + * Operate by calling the operator 'op' on each element from + * largest towards smaller elements. + * + * Destroy elements by calling the destructor 'destr'. Elements + * are destroyed when not needed by the tree structure anymore. + * Note that elements are often destroyed in another order + * than the order that the elements are operated on. + * + * 'arg' is passed as argument to 'op' and 'destroy'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy_yielding( + * ERTS_RBT_T **tree, + * void (*op)(ERTS_RBT_T *, void *), + * void (*destr)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element from + * smallest towards larger elements. + * + * Destroy elements by calling the destructor 'destr'. Elements + * are destroyed when not needed by the tree structure anymore. + * Note that elements are often destroyed in another order + * than the order that the elements are operated on. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. The tree should not be + * modified until all of it has been processed. + * + * 'arg' is passed as argument to 'op' and 'destroy'. + * + * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy_yielding( + * ERTS_RBT_T **tree, + * void (*op)(ERTS_RBT_T *, void *), + * void (*destr)(ERTS_RBT_T *, void *), + * void *arg, + * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, + * Sint ylimit); + * Operate by calling the operator 'op' on each element from + * largest towards smaller elements. + * + * Destroy elements by calling the destructor 'destr'. Elements + * are destroyed when not needed by the tree structure anymore. + * Note that elements are often destroyed in another order + * than the order that the elements are operated on. + * + * Yield when 'ylimit' elements has been processed. Zero is + * returned when yielding, and a non-zero value is returned when + * the whole tree has been processed. The tree should not be + * modified until all of it has been processed. + * + * 'arg' is passed as argument to 'op' and 'destroy'. + * + * - void <ERTS_RBT_PREFIX>_rbt_debug_print( + * FILE *filep, + * ERTS_RBT_T *x, + * int indent, + * (void)(*print_node)(ERTS_RBT_T *)); + * Prints the tree. Note that this function is recursive. + * Should only be used for debuging. + */ + + +/* + * Check that we have all mandatory defines + */ +#ifndef ERTS_RBT_PREFIX +# error Missing definition of ERTS_RBT_PREFIX +#endif +#ifndef ERTS_RBT_T +# error Missing definition of ERTS_RBT_T +#endif +#ifndef ERTS_RBT_KEY_T +# error Missing definition of ERTS_RBT_KEY_T +#endif +#ifndef ERTS_RBT_FLAGS_T +# error Missing definition of ERTS_RBT_FLAGS_T +#endif +#ifndef ERTS_RBT_INIT_EMPTY_TNODE +# error Missing definition of ERTS_RBT_INIT_EMPTY_TNODE +#endif +#ifndef ERTS_RBT_IS_RED +# error Missing definition of ERTS_RBT_IS_RED +#endif +#ifndef ERTS_RBT_SET_RED +# error Missing definition of ERTS_RBT_SET_RED +#endif +#ifndef ERTS_RBT_IS_BLACK +# error Missing definition of ERTS_RBT_IS_BLACK +#endif +#ifndef ERTS_RBT_SET_BLACK +# error Missing definition of ERTS_RBT_SET_BLACK +#endif +#ifndef ERTS_RBT_GET_FLAGS +# error Missing definition of ERTS_RBT_GET_FLAGS +#endif +#ifndef ERTS_RBT_SET_FLAGS +# error Missing definition of ERTS_RBT_SET_FLAGS +#endif +#ifndef ERTS_RBT_GET_PARENT +# error Missing definition of ERTS_RBT_GET_PARENT +#endif +#ifndef ERTS_RBT_SET_PARENT +# error Missing definition of ERTS_RBT_SET_PARENT +#endif +#ifndef ERTS_RBT_GET_RIGHT +# error Missing definition of ERTS_RBT_GET_RIGHT +#endif +#ifndef ERTS_RBT_GET_LEFT +# error Missing definition of ERTS_RBT_GET_LEFT +#endif +#ifndef ERTS_RBT_IS_LT +# error Missing definition of ERTS_RBT_IS_LT +#endif +#ifndef ERTS_RBT_GET_KEY +# error Missing definition of ERTS_RBT_GET_KEY +#endif +#ifndef ERTS_RBT_IS_EQ +# error Missing definition of ERTS_RBT_IS_EQ +#endif + +#if defined(ERTS_RBT_HARD_DEBUG) || defined(DEBUG) +# ifndef ERTS_RBT_DEBUG +# define ERTS_RBT_DEBUG 1 +# endif +#endif + +#if defined(ERTS_RBT_HARD_DEBUG) && defined(__GNUC__) +#warning "* * * * * * * * * * * * * * * * * *" +#warning "* ERTS_RBT_HARD_DEBUG IS ENABLED! *" +#warning "* * * * * * * * * * * * * * * * * *" +#endif + +#undef ERTS_RBT_ASSERT +#if defined(ERTS_RBT_DEBUG) +#define ERTS_RBT_ASSERT(E) ERTS_ASSERT(E) +#else +#define ERTS_RBT_ASSERT(E) ((void) 1) +#endif + +#undef ERTS_RBT_API_INLINE__ +#if defined(ERTS_RBT_NO_API_INLINE) || defined(ERTS_RBT_DEBUG) +# define ERTS_RBT_API_INLINE__ +#else +# define ERTS_RBT_API_INLINE__ ERTS_INLINE +#endif + +#ifndef ERTS_RBT_YIELD_STAT_INITER +# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0} +#endif + +#define ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) \ + X ## Y +#define ERTS_RBT_CONCAT_MACRO_VALUES__(X, Y) \ + ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) + +#undef ERTS_RBT_YIELD_STATE_T__ +#define ERTS_RBT_YIELD_STATE_T__ \ + ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_yield_state_t) + +typedef struct { + ERTS_RBT_T *x; + int up; +} ERTS_RBT_YIELD_STATE_T__; + +#define ERTS_RBT_FUNC__(Name) \ + ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_ ## Name) + +#undef ERTS_RBT_NEED_REPLACE__ +#undef ERTS_RBT_NEED_INSERT__ +#undef ERTS_RBT_NEED_ROTATE__ +#undef ERTS_RBT_NEED_FOREACH_UNORDERED__ +#undef ERTS_RBT_NEED_FOREACH_ORDERED__ +#undef ERTS_RBT_NEED_HDBG_CHECK_TREE__ +#undef ERTS_RBT_HDBG_CHECK_TREE__ + +#if defined(ERTS_RBT_WANT_REPLACE) || defined(ERTS_RBT_WANT_DELETE) +# define ERTS_RBT_NEED_REPLACE__ +#endif +#if defined(ERTS_RBT_WANT_INSERT) || defined(ERTS_RBT_WANT_LOOKUP_INSERT) +# define ERTS_RBT_NEED_INSERT__ +#endif +#if defined(ERTS_RBT_WANT_DELETE) || defined(ERTS_RBT_NEED_INSERT__) +# define ERTS_RBT_NEED_ROTATE__ +#endif +#if defined(ERTS_RBT_WANT_FOREACH) \ + || defined(ERTS_RBT_WANT_FOREACH_YIELDING) \ + || defined(ERTS_RBT_WANT_FOREACH_DESTROY) \ + || defined(ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING) +# define ERTS_RBT_NEED_FOREACH_UNORDERED__ +#endif +#if defined(ERTS_RBT_WANT_FOREACH_SMALL) \ + || defined(ERTS_RBT_WANT_FOREACH_LARGE) \ + || defined(ERTS_RBT_WANT_FOREACH_SMALL_YIELDING) \ + || defined(ERTS_RBT_WANT_FOREACH_LARGE_YIELDING) \ + || defined(ERTS_RBT_WANT_FOREACH_SMALL_DESTROY) \ + || defined(ERTS_RBT_WANT_FOREACH_LARGE_DESTROY) \ + || defined(ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING) \ + || defined(ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING) +# define ERTS_RBT_NEED_FOREACH_ORDERED__ +#endif +#if defined(ERTS_RBT_HARD_DEBUG) \ + && (defined(ERTS_RBT_WANT_DELETE) \ + || defined(ERTS_RBT_NEED_INSERT__)) +static void ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root); +# define ERTS_RBT_NEED_HDBG_CHECK_TREE__ +# define ERTS_RBT_HDBG_CHECK_TREE__(R) \ + ERTS_RBT_FUNC__(hdbg_check_tree)((R)) +#else +# define ERTS_RBT_HDBG_CHECK_TREE__(R) ((void) 1) +#endif + +#ifdef ERTS_RBT_NEED_ROTATE__ + +static ERTS_INLINE void +ERTS_RBT_FUNC__(left_rotate__)(ERTS_RBT_T **root, ERTS_RBT_T *x) +{ + ERTS_RBT_T *y, *l, *p; + + y = ERTS_RBT_GET_RIGHT(x); + l = ERTS_RBT_GET_LEFT(y); + ERTS_RBT_SET_RIGHT(x, l); + + if (l) + ERTS_RBT_SET_PARENT(l, x); + + p = ERTS_RBT_GET_PARENT(x); + ERTS_RBT_SET_PARENT(y, p); + + if (!p) { + ERTS_RBT_ASSERT(*root == x); + *root = y; +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y); +#endif + } + else if (x == ERTS_RBT_GET_LEFT(p)) + ERTS_RBT_SET_LEFT(p, y); + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p)); + ERTS_RBT_SET_RIGHT(p, y); + } + ERTS_RBT_SET_LEFT(y, x); + ERTS_RBT_SET_PARENT(x, y); + +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE + ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(!0, x, y); +#endif + +} + +static ERTS_INLINE void +ERTS_RBT_FUNC__(right_rotate__)(ERTS_RBT_T **root, ERTS_RBT_T *x) +{ + ERTS_RBT_T *y, *r, *p; + + y = ERTS_RBT_GET_LEFT(x); + r = ERTS_RBT_GET_RIGHT(y); + ERTS_RBT_SET_LEFT(x, r); + + if (r) + ERTS_RBT_SET_PARENT(r, x); + + p = ERTS_RBT_GET_PARENT(x); + ERTS_RBT_SET_PARENT(y, p); + + if (!p) { + ERTS_RBT_ASSERT(*root == x); + *root = y; +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y); +#endif + } + else if (x == ERTS_RBT_GET_RIGHT(p)) + ERTS_RBT_SET_RIGHT(p, y); + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(p)); + ERTS_RBT_SET_LEFT(p, y); + } + + ERTS_RBT_SET_RIGHT(y, x); + ERTS_RBT_SET_PARENT(x, y); + +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE + ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(0, x, y); +#endif + +} + +#endif /* ERTS_RBT_NEED_ROTATE__ */ + +#ifdef ERTS_RBT_NEED_REPLACE__ + +/* + * Replace node x with node y + */ +static ERTS_INLINE void +ERTS_RBT_FUNC__(replace__)(ERTS_RBT_T **root, ERTS_RBT_T *x, ERTS_RBT_T *y) +{ + ERTS_RBT_T *p, *r, *l; + ERTS_RBT_FLAGS_T f; + + p = ERTS_RBT_GET_PARENT(x); + if (!p) { + ERTS_RBT_ASSERT(*root == x); + *root = y; +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y); +#endif + } + else if (x == ERTS_RBT_GET_LEFT(p)) + ERTS_RBT_SET_LEFT(p, y); + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p)); + ERTS_RBT_SET_RIGHT(p, y); + } + l = ERTS_RBT_GET_LEFT(x); + if (l) { + ERTS_RBT_ASSERT(ERTS_RBT_GET_PARENT(l) == x); + ERTS_RBT_SET_PARENT(l, y); + } + r = ERTS_RBT_GET_RIGHT(x); + if (r) { + ERTS_RBT_ASSERT(ERTS_RBT_GET_PARENT(r) == x); + ERTS_RBT_SET_PARENT(r, y); + } + + f = ERTS_RBT_GET_FLAGS(x); + ERTS_RBT_SET_FLAGS(y, f); + ERTS_RBT_SET_PARENT(y, p); + ERTS_RBT_SET_RIGHT(y, r); + ERTS_RBT_SET_LEFT(y, l); +} + +#endif /* ERTS_RBT_NEED_REPLACE__ */ + +#ifdef ERTS_RBT_WANT_REPLACE + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(replace)(ERTS_RBT_T **root, ERTS_RBT_T *x, ERTS_RBT_T *y) +{ + ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(x), + ERTS_RBT_GET_KEY(y))); + + ERTS_RBT_FUNC__(replace__)(root, x, y); +} + +#endif /* ERTS_RBT_WANT_REPLACE */ + +#ifdef ERTS_RBT_WANT_DELETE + +/* + * Delete a node. + */ +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(delete)(ERTS_RBT_T **root, ERTS_RBT_T *n) +{ + int spliced_is_black; + ERTS_RBT_T *p, *x, *y, *z = n; + ERTS_RBT_T null_x; /* null_x is used to get the fixup started when we + splice out a node without children. */ + + ERTS_RBT_HDBG_CHECK_TREE__(*root); + + ERTS_RBT_INIT_EMPTY_TNODE(&null_x); + + /* Remove node from tree... */ + + /* Find node to splice out */ + if (!ERTS_RBT_GET_LEFT(z) || !ERTS_RBT_GET_RIGHT(z)) + y = z; + else { + /* Set y to z:s successor */ + y = ERTS_RBT_GET_RIGHT(z); + while (1) { + ERTS_RBT_T *t = ERTS_RBT_GET_LEFT(y); + if (!t) + break; + y = t; + } + } + /* splice out y */ + x = ERTS_RBT_GET_LEFT(y); + if (!x) + x = ERTS_RBT_GET_RIGHT(y); + spliced_is_black = ERTS_RBT_IS_BLACK(y); + p = ERTS_RBT_GET_PARENT(y); + if (x) + ERTS_RBT_SET_PARENT(x, p); + else if (spliced_is_black) { + x = &null_x; + ERTS_RBT_SET_BLACK(x); + ERTS_RBT_SET_PARENT(x, p); + ERTS_RBT_SET_LEFT(y, x); + } + + if (!p) { + ERTS_RBT_ASSERT(*root == y); + *root = x; +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(y, x); +#endif + } + else { + if (y == ERTS_RBT_GET_LEFT(p)) + ERTS_RBT_SET_LEFT(p, x); + else { + ERTS_RBT_ASSERT(y == ERTS_RBT_GET_RIGHT(p)); + ERTS_RBT_SET_RIGHT(p, x); + } +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD + if (p != z) + ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(p, y == z ? NULL : z); +#endif + } + if (y != z) { + /* We spliced out the successor of z; replace z by the successor */ + ERTS_RBT_FUNC__(replace__)(root, z, y); +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD + ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(y, NULL); +#endif + } + + if (spliced_is_black) { + /* We removed a black node which makes the resulting tree + violate the Red-Black Tree properties. Fixup tree... */ + + p = ERTS_RBT_GET_PARENT(x); + while (ERTS_RBT_IS_BLACK(x) && p) { + ERTS_RBT_T *r, *l; + + /* + * x has an "extra black" which we move up the tree + * until we reach the root or until we can get rid of it. + * + * y is the sibbling of x, and p is their parent + */ + + if (x == ERTS_RBT_GET_LEFT(p)) { + y = ERTS_RBT_GET_RIGHT(p); + + ERTS_RBT_ASSERT(y); + + if (ERTS_RBT_IS_RED(y)) { + ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y)); + ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y)); + + ERTS_RBT_SET_BLACK(y); + + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(p)); + + ERTS_RBT_SET_RED(p); + ERTS_RBT_FUNC__(left_rotate__)(root, p); + p = ERTS_RBT_GET_PARENT(x); + y = ERTS_RBT_GET_RIGHT(p); + } + + ERTS_RBT_ASSERT(y); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(y)); + + l = ERTS_RBT_GET_LEFT(y); + r = ERTS_RBT_GET_RIGHT(y); + if ((!l || ERTS_RBT_IS_BLACK(l)) + && (!r || ERTS_RBT_IS_BLACK(r))) { + ERTS_RBT_SET_RED(y); + x = p; + p = ERTS_RBT_GET_PARENT(x); + } + else { + if (!r || ERTS_RBT_IS_BLACK(r)) { + ERTS_RBT_SET_BLACK(l); + ERTS_RBT_SET_RED(y); + ERTS_RBT_FUNC__(right_rotate__)(root, y); + p = ERTS_RBT_GET_PARENT(x); + y = ERTS_RBT_GET_RIGHT(p); + } + + ERTS_RBT_ASSERT(y); + + if (p && ERTS_RBT_IS_RED(p)) { + + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(y); + } + + ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y)); + + ERTS_RBT_SET_BLACK(ERTS_RBT_GET_RIGHT(y)); + ERTS_RBT_FUNC__(left_rotate__)(root, p); + x = *root; + break; + } + } + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p)); + + y = ERTS_RBT_GET_LEFT(p); + + ERTS_RBT_ASSERT(y); + + if (ERTS_RBT_IS_RED(y)) { + ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y)); + ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y)); + + ERTS_RBT_SET_BLACK(y); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(p)); + ERTS_RBT_SET_RED(p); + ERTS_RBT_FUNC__(right_rotate__)(root, p); + + p = ERTS_RBT_GET_PARENT(x); + y = ERTS_RBT_GET_LEFT(p); + } + + ERTS_RBT_ASSERT(y); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(y)); + + l = ERTS_RBT_GET_LEFT(y); + r = ERTS_RBT_GET_RIGHT(y); + + if ((!r || ERTS_RBT_IS_BLACK(r)) + && (!l || ERTS_RBT_IS_BLACK(l))) { + ERTS_RBT_SET_RED(y); + x = p; + p = ERTS_RBT_GET_PARENT(x); + } + else { + if (!l || ERTS_RBT_IS_BLACK(l)) { + ERTS_RBT_SET_BLACK(r); + ERTS_RBT_SET_RED(y); + ERTS_RBT_FUNC__(left_rotate__)(root, y); + + p = ERTS_RBT_GET_PARENT(x); + y = ERTS_RBT_GET_LEFT(p); + } + + ERTS_RBT_ASSERT(y); + + if (p && ERTS_RBT_IS_RED(p)) { + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(y); + } + + ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y)); + + ERTS_RBT_SET_BLACK(ERTS_RBT_GET_LEFT(y)); + ERTS_RBT_FUNC__(right_rotate__)(root, p); + x = *root; + break; + } + } + } + + ERTS_RBT_SET_BLACK(x); + + x = &null_x; + p = ERTS_RBT_GET_PARENT(x); + + if (p) { + if (ERTS_RBT_GET_LEFT(p) == x) + ERTS_RBT_SET_LEFT(p, NULL); + else { + ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(p) == x); + ERTS_RBT_SET_RIGHT(p, NULL); + } + + ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x)); + ERTS_RBT_ASSERT(!ERTS_RBT_GET_RIGHT(x)); + } + else if (*root == x) { + *root = NULL; + +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, NULL); +#endif + + ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x)); + ERTS_RBT_ASSERT(!ERTS_RBT_GET_RIGHT(x)); + } + } + + ERTS_RBT_HDBG_CHECK_TREE__(*root); + +} + +#endif /* ERTS_RBT_WANT_DELETE */ + +#ifdef ERTS_RBT_NEED_INSERT__ + +static void +ERTS_RBT_FUNC__(insert_fixup__)(ERTS_RBT_T **root, ERTS_RBT_T *n) +{ + ERTS_RBT_T *x, *y; + + x = n; + + /* + * Rearrange the tree so that it satisfies the Red-Black Tree properties + */ + + ERTS_RBT_ASSERT(x != *root && ERTS_RBT_IS_RED(ERTS_RBT_GET_PARENT(x))); + do { + ERTS_RBT_T *p, *pp; + + /* + * x and its parent are both red. Move the red pair up the tree + * until we get to the root or until we can separate them. + */ + + p = ERTS_RBT_GET_PARENT(x); + pp = ERTS_RBT_GET_PARENT(p); + + ERTS_RBT_ASSERT(p && pp); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp)); + + if (p == ERTS_RBT_GET_LEFT(pp)) { + y = ERTS_RBT_GET_RIGHT(pp); + if (y && ERTS_RBT_IS_RED(y)) { + ERTS_RBT_SET_BLACK(y); + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(pp); + x = pp; + } + else { + + if (x == ERTS_RBT_GET_RIGHT(p)) { + x = p; + ERTS_RBT_FUNC__(left_rotate__)(root, x); + p = ERTS_RBT_GET_PARENT(x); + pp = ERTS_RBT_GET_PARENT(p); + + ERTS_RBT_ASSERT(p && pp); + } + + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(ERTS_RBT_GET_LEFT(pp))); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(p)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp)); + ERTS_RBT_ASSERT(!y || ERTS_RBT_IS_BLACK(y)); + + + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(pp); + ERTS_RBT_FUNC__(right_rotate__)(root, pp); + + + ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(ERTS_RBT_GET_PARENT(x)) == x); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED( + ERTS_RBT_GET_RIGHT( + ERTS_RBT_GET_PARENT(x)))); + ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x) + || ERTS_RBT_IS_BLACK(ERTS_RBT_GET_PARENT(x))); + break; + } + } + else { + ERTS_RBT_ASSERT(p == ERTS_RBT_GET_RIGHT(pp)); + + y = ERTS_RBT_GET_LEFT(pp); + if (y && ERTS_RBT_IS_RED(y)) { + ERTS_RBT_SET_BLACK(y); + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(pp); + x = pp; + } + else { + + if (x == ERTS_RBT_GET_LEFT(p)) { + x = p; + ERTS_RBT_FUNC__(right_rotate__)(root, x); + p = ERTS_RBT_GET_PARENT(x); + pp = ERTS_RBT_GET_PARENT(p); + + ERTS_RBT_ASSERT(p && pp); + } + + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(ERTS_RBT_GET_RIGHT(pp))); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(p)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp)); + ERTS_RBT_ASSERT(!y || ERTS_RBT_IS_BLACK(y)); + + + ERTS_RBT_SET_BLACK(p); + ERTS_RBT_SET_RED(pp); + ERTS_RBT_FUNC__(left_rotate__)(root, pp); + + + ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(ERTS_RBT_GET_PARENT(x)) == x); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x)); + ERTS_RBT_ASSERT(ERTS_RBT_IS_RED( + ERTS_RBT_GET_LEFT( + ERTS_RBT_GET_PARENT(x)))); + ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x) + || ERTS_RBT_IS_BLACK(ERTS_RBT_GET_PARENT(x))); + break; + } + } + } while (x != *root && ERTS_RBT_IS_RED(ERTS_RBT_GET_PARENT(x))); + + ERTS_RBT_SET_BLACK(*root); + +} + +static ERTS_INLINE ERTS_RBT_T * +ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup) +{ + ERTS_RBT_KEY_T kn = ERTS_RBT_GET_KEY(n); + + ERTS_RBT_HDBG_CHECK_TREE__(*root); + + ERTS_RBT_INIT_EMPTY_TNODE(n); + + if (!*root) { + ERTS_RBT_SET_BLACK(n); + *root = n; +#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT + ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(NULL, n); +#endif + } + else { + ERTS_RBT_T *p, *x = *root; + + while (1) { + ERTS_RBT_KEY_T kx; + ERTS_RBT_T *c; + + kx = ERTS_RBT_GET_KEY(x); + + if (lookup && ERTS_RBT_IS_EQ(kn, kx)) { + + ERTS_RBT_HDBG_CHECK_TREE__(*root); + + return x; + } + + if (ERTS_RBT_IS_LT(kn, kx)) { + c = ERTS_RBT_GET_LEFT(x); + if (!c) { + ERTS_RBT_SET_PARENT(n, x); + ERTS_RBT_SET_LEFT(x, n); + p = x; + break; + } + } + else { + c = ERTS_RBT_GET_RIGHT(x); + if (!c) { + ERTS_RBT_SET_PARENT(n, x); + ERTS_RBT_SET_RIGHT(x, n); + p = x; + break; + } + } + + x = c; + } + + ERTS_RBT_ASSERT(p); + + ERTS_RBT_SET_RED(n); + if (ERTS_RBT_IS_RED(p)) + ERTS_RBT_FUNC__(insert_fixup__)(root, n); + } + + ERTS_RBT_HDBG_CHECK_TREE__(*root); + + return NULL; +} + +#endif /* ERTS_RBT_NEED_INSERT__ */ + +#ifdef ERTS_RBT_WANT_LOOKUP_INSERT + +static ERTS_RBT_API_INLINE__ ERTS_RBT_T * +ERTS_RBT_FUNC__(lookup_insert)(ERTS_RBT_T **root, ERTS_RBT_T *n) +{ + return ERTS_RBT_FUNC__(insert_aux__)(root, n, !0); +} + +#endif /* ERTS_RBT_WANT_LOOKUP_INSERT */ + +#ifdef ERTS_RBT_WANT_INSERT + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(insert)(ERTS_RBT_T **root, ERTS_RBT_T *n) +{ + (void) ERTS_RBT_FUNC__(insert_aux__)(root, n, 0); +} + +#endif /* ERTS_RBT_WANT_INSERT */ + +#ifdef ERTS_RBT_WANT_LOOKUP + +static ERTS_RBT_API_INLINE__ ERTS_RBT_T * +ERTS_RBT_FUNC__(lookup)(ERTS_RBT_T *root, ERTS_RBT_KEY_T key) +{ + ERTS_RBT_T *x = root; + + if (!x) + return NULL; + + while (1) { + ERTS_RBT_KEY_T kx = ERTS_RBT_GET_KEY(x); + ERTS_RBT_T *c; + + if (ERTS_RBT_IS_EQ(key, kx)) + return x; + + if (ERTS_RBT_IS_LT(key, kx)) { + c = ERTS_RBT_GET_LEFT(x); + if (!c) + return NULL; + } + else { + c = ERTS_RBT_GET_RIGHT(x); + if (!c) + return NULL; + } + + x = c; + } +} + +#endif /* ERTS_RBT_WANT_LOOKUP */ + +#ifdef ERTS_RBT_WANT_SMALLEST + +static ERTS_RBT_API_INLINE__ ERTS_RBT_T * +ERTS_RBT_FUNC__(smallest)(ERTS_RBT_T *root) +{ + ERTS_RBT_T *x = root; + + if (!x) + return NULL; + + while (1) { + ERTS_RBT_T *c = ERTS_RBT_GET_LEFT(x); + if (!c) + break; + x = c; + } + + return x; +} + +#endif /* ERTS_RBT_WANT_SMALLEST */ + +#ifdef ERTS_RBT_WANT_LARGEST + +static ERTS_RBT_API_INLINE__ ERTS_RBT_T * +ERTS_RBT_FUNC__(largest)(ERTS_RBT_T *root) +{ + ERTS_RBT_T *x = root; + + if (!x) + return NULL; + + while (1) { + ERTS_RBT_T *c = ERTS_RBT_GET_RIGHT(x); + if (!c) + break; + x = c; + } + + return x; +} + +#endif /* ERTS_RBT_WANT_LARGEST */ + +#ifdef ERTS_RBT_NEED_FOREACH_UNORDERED__ + +static ERTS_INLINE int +ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root, + int destroying, + void (*op)(ERTS_RBT_T *, void *), + void *arg, + int yielding, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + ERTS_RBT_T *c, *p, *x; + + ERTS_RBT_ASSERT(!yielding || ystate); + + if (yielding && ystate->x) { + x = ystate->x; + ERTS_RBT_ASSERT(ystate->up); + goto restart_up; + } + else { + x = *root; + if (!x) + return 0; + if (destroying) + *root = NULL; + } + + while (1) { + + while (1) { + + while (1) { + c = ERTS_RBT_GET_LEFT(x); + if (!c) + break; + x = c; + } + + c = ERTS_RBT_GET_RIGHT(x); + if (!c) + break; + x = c; + } + + while (1) { +#ifdef ERTS_RBT_DEBUG + int cdir; +#endif + if (yielding && ylimit-- <= 0) { + ystate->x = x; + ystate->up = 1; + return 1; + } + + restart_up: + + p = ERTS_RBT_GET_PARENT(x); + +#ifdef ERTS_RBT_DEBUG + ERTS_RBT_ASSERT(!destroying || !ERTS_RBT_GET_LEFT(x)); + ERTS_RBT_ASSERT(!destroying || !ERTS_RBT_GET_RIGHT(x)); + + if (p) { + if (x == ERTS_RBT_GET_LEFT(p)) { + cdir = -1; + if (destroying) + ERTS_RBT_SET_LEFT(p, NULL); + } + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p)); + cdir = 1; + if (destroying) + ERTS_RBT_SET_RIGHT(p, NULL); + } + } +#endif + + (*op)(x, arg); + + if (!p) { + if (yielding) { + ystate->x = NULL; + ystate->up = 0; + } + return 0; /* Done */ + } + + c = ERTS_RBT_GET_RIGHT(p); + if (c && c != x) { + ERTS_RBT_ASSERT(cdir < 0); + + /* Go down tree of x's sibling... */ + x = c; + break; + } + + x = p; + } + } +} + +#endif /* ERTS_RBT_NEED_FOREACH_UNORDERED__ */ + +#ifdef ERTS_RBT_NEED_FOREACH_ORDERED__ + +static ERTS_INLINE int +ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, + int from_small, + int destroying, + void (*op)(ERTS_RBT_T *, void *), + void (*destroy)(ERTS_RBT_T *, void *), + void *arg, + int yielding, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + ERTS_RBT_T *c, *p, *x; + + ERTS_RBT_ASSERT(!yielding || ystate); + ERTS_RBT_ASSERT(!destroying || destroy); + + if (yielding && ystate->x) { + x = ystate->x; + if (ystate->up) + goto restart_up; + else + goto restart_down; + } + else { + x = *root; + if (!x) + return 0; + if (destroying) + *root = NULL; + } + + while (1) { + + while (1) { + + while (1) { + c = from_small ? ERTS_RBT_GET_LEFT(x) : ERTS_RBT_GET_RIGHT(x); + if (!c) + break; + x = c; + } + + (*op)(x, arg); + + if (yielding && --ylimit <= 0) { + ystate->x = x; + ystate->up = 0; + return 1; + } + + restart_down: + + c = from_small ? ERTS_RBT_GET_RIGHT(x) : ERTS_RBT_GET_LEFT(x); + if (!c) + break; + x = c; + } + + while (1) { + p = ERTS_RBT_GET_PARENT(x); + + if (p) { + + c = from_small ? ERTS_RBT_GET_RIGHT(p) : ERTS_RBT_GET_LEFT(p); + if (!c || c != x) { + ERTS_RBT_ASSERT((from_small + ? ERTS_RBT_GET_LEFT(p) + : ERTS_RBT_GET_RIGHT(p)) == x); + + (*op)(p, arg); + + if (yielding && --ylimit <= 0) { + ystate->x = x; + ystate->up = 1; + return 1; + restart_up: + p = ERTS_RBT_GET_PARENT(x); + } + } + + if (c && c != x) { + ERTS_RBT_ASSERT((from_small + ? ERTS_RBT_GET_LEFT(p) + : ERTS_RBT_GET_RIGHT(p)) == x); + + /* Go down tree of x's sibling... */ + x = c; + break; + } + } + + if (destroying) { + +#ifdef ERTS_RBT_DEBUG + ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x) + && !ERTS_RBT_GET_RIGHT(x)); + + if (p) { + if (x == ERTS_RBT_GET_LEFT(p)) + ERTS_RBT_SET_LEFT(p, NULL); + else { + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p)); + ERTS_RBT_SET_RIGHT(p, NULL); + } + } +#endif + + (*destroy)(x, arg); + } + + if (!p) { + if (yielding) { + ystate->x = NULL; + ystate->up = 0; + } + return 1; /* Done */ + } + x = p; + } + } +} + +#endif /* ERTS_RBT_NEED_FOREACH_ORDERED__ */ + +#ifdef ERTS_RBT_WANT_FOREACH + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH */ + +#ifdef ERTS_RBT_WANT_FOREACH_SMALL + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0, + op, NULL, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH_SMALL */ + +#ifdef ERTS_RBT_WANT_FOREACH_LARGE + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0, + op, NULL, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH_LARGE */ + +#ifdef ERTS_RBT_WANT_FOREACH_YIELDING + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + (void) ERTS_RBT_FUNC__(foreach_unordered__)(*root, 0, op, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_YIELDING */ + +#ifdef ERTS_RBT_WANT_FOREACH_SMALL_YIELDING + +static ERTS_RBT_API_INLINE__ int +ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0, + op, NULL, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_SMALL_YIELDING */ + +#ifdef ERTS_RBT_WANT_FOREACH_LARGE_YIELDING + +static ERTS_RBT_API_INLINE__ int +ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root, + void (*op)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0, + op, NULL, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_LARGE_YIELDING */ + +#ifdef ERTS_RBT_WANT_FOREACH_DESTROY + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH_DESTROY */ + +#ifdef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void (*destr)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1, + op, destr, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY */ + +#ifdef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY + +static ERTS_RBT_API_INLINE__ void +ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void (*destr)(ERTS_RBT_T *, void *), + void *arg) +{ + (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1, + op, destr, arg, + 0, NULL, 0); +} + +#endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY */ + +#ifdef ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING + +static ERTS_RBT_API_INLINE__ int +ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + return ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING */ + +#ifdef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING + +static ERTS_RBT_API_INLINE__ int +ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void (*destr)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + return ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1, + op, destr, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING */ + +#ifdef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING + +static ERTS_RBT_API_INLINE__ int +ERTS_RBT_FUNC__(foreach_large_destroy_yielding)(ERTS_RBT_T **root, + void (*op)(ERTS_RBT_T *, void *), + void (*destr)(ERTS_RBT_T *, void *), + void *arg, + ERTS_RBT_YIELD_STATE_T__ *ystate, + Sint ylimit) +{ + return ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1, + op, destr, arg, + 1, ystate, ylimit); +} + +#endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING */ + +#ifdef ERTS_RBT_WANT_DEBUG_PRINT + +static void +ERTS_RBT_FUNC__(debug_print)(FILE *filep, ERTS_RBT_T *x, int indent, + void (*print_node)(ERTS_RBT_T *)) +{ + if (x) { + ERTS_RBT_FUNC__(debug_print)(filep, ERTS_RBT_GET_RIGHT(x), + indent+2, print_node); + erts_fprintf(filep, + "%*s[%s:%p:", + indent, "", + ERTS_RBT_IS_BLACK(x) ? "Black" : "Red", + x); + (*print_node)(x); + erts_fprintf(filep, "]\n"); + ERTS_RBT_FUNC__(debug_print)(filep, ERTS_RBT_GET_LEFT(x), + indent+2, print_node); + } +} + +#endif /* ERTS_RBT_WANT_DEBUG_PRINT */ + +#ifdef ERTS_RBT_NEED_HDBG_CHECK_TREE__ + +static void +ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root) +{ + int black_depth = -1, no_black = 0; + ERTS_RBT_T *c, *p, *x = root; + ERTS_RBT_KEY_T kx; + ERTS_RBT_KEY_T kc; + + if (!x) + return; + + ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x)); + + while (1) { + + while (1) { + + while (1) { + + if (ERTS_RBT_IS_BLACK(x)) + no_black++; + else { + c = ERTS_RBT_GET_RIGHT(x); + ERTS_RBT_ASSERT(!c || ERTS_RBT_IS_BLACK(c)); + c = ERTS_RBT_GET_LEFT(x); + ERTS_RBT_ASSERT(!c || ERTS_RBT_IS_BLACK(c)); + } + + c = ERTS_RBT_GET_LEFT(x); + if (!c) + break; + + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_PARENT(c)); + + kx = ERTS_RBT_GET_KEY(x); + kc = ERTS_RBT_GET_KEY(c); + + ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kc, kx) + || ERTS_RBT_IS_EQ(kc, kx)); + + x = c; + } + + c = ERTS_RBT_GET_RIGHT(x); + if (!c) { + if (black_depth < 0) + black_depth = no_black; + ERTS_RBT_ASSERT(black_depth == no_black); + break; + } + + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_PARENT(c)); + + kx = ERTS_RBT_GET_KEY(x); + kc = ERTS_RBT_GET_KEY(c); + + ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc) + || ERTS_RBT_IS_EQ(kx, kc)); + x = c; + } + + while (1) { + p = ERTS_RBT_GET_PARENT(x); + + if (ERTS_RBT_IS_BLACK(x)) + no_black--; + + if (p) { + + ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(p) + || x == ERTS_RBT_GET_RIGHT(p)); + + c = ERTS_RBT_GET_RIGHT(p); + if (c && c != x) { + ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(p) == x); + + kx = ERTS_RBT_GET_KEY(x); + kc = ERTS_RBT_GET_KEY(c); + + ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc) + || ERTS_RBT_IS_EQ(kx, kc)); + /* Go down tree of x's sibling... */ + x = c; + break; + } + } + + if (!p) { + ERTS_RBT_ASSERT(root == x); + ERTS_RBT_ASSERT(no_black == 0); + return; /* Done */ + } + + x = p; + } + } +} + +#undef ERTS_RBT_PRINT_TREE__ + +#endif /* ERTS_RBT_NEED_HDBG_CHECK_TREE__ */ + +#undef ERTS_RBT_ASSERT +#undef ERTS_RBT_DEBUG +#undef ERTS_RBT_API_INLINE__ +#undef ERTS_RBT_YIELD_STATE_T__ +#undef ERTS_RBT_NEED_REPLACE__ +#undef ERTS_RBT_NEED_INSERT__ +#undef ERTS_RBT_NEED_ROTATE__ +#undef ERTS_RBT_NEED_FOREACH_UNORDERED__ +#undef ERTS_RBT_NEED_FOREACH_ORDERED__ +#undef ERTS_RBT_NEED_HDBG_CHECK_TREE__ +#undef ERTS_RBT_HDBG_CHECK_TREE__ + +#ifdef ERTS_RBT_UNDEF +# undef ERTS_RBT_PREFIX +# undef ERTS_RBT_T +# undef ERTS_RBT_KEY_T +# undef ERTS_RBT_FLAGS_T +# undef ERTS_RBT_INIT_EMPTY_TNODE +# undef ERTS_RBT_IS_RED +# undef ERTS_RBT_SET_RED +# undef ERTS_RBT_IS_BLACK +# undef ERTS_RBT_SET_BLACK +# undef ERTS_RBT_GET_FLAGS +# undef ERTS_RBT_SET_FLAGS +# undef ERTS_RBT_GET_PARENT +# undef ERTS_RBT_SET_PARENT +# undef ERTS_RBT_GET_RIGHT +# undef ERTS_RBT_SET_RIGHT +# undef ERTS_RBT_GET_LEFT +# undef ERTS_RBT_SET_LEFT +# undef ERTS_RBT_GET_KEY +# undef ERTS_RBT_IS_LT +# undef ERTS_RBT_IS_EQ +# undef ERTS_RBT_UNDEF +# undef ERTS_RBT_NO_API_INLINE +# undef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE +# undef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD +# undef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT +# undef ERTS_RBT_WANT_DELETE +# undef ERTS_RBT_WANT_INSERT +# undef ERTS_RBT_WANT_LOOKUP_INSERT +# undef ERTS_RBT_WANT_REPLACE +# undef ERTS_RBT_WANT_LOOKUP +# undef ERTS_RBT_WANT_SMALLEST +# undef ERTS_RBT_WANT_LARGEST +# undef ERTS_RBT_WANT_FOREACH +# undef ERTS_RBT_WANT_FOREACH_DESTROY +# undef ERTS_RBT_WANT_FOREACH_YIELDING +# undef ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +# undef ERTS_RBT_WANT_FOREACH_SMALL +# undef ERTS_RBT_WANT_FOREACH_LARGE +# undef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY +# undef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY +# undef ERTS_RBT_WANT_FOREACH_SMALL_YIELDING +# undef ERTS_RBT_WANT_FOREACH_LARGE_YIELDING +# undef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING +# undef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING +# undef ERTS_RBT_WANT_DEBUG_PRINT +#endif diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index 4c9b00d2ee..78e0964e8b 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -1360,6 +1360,7 @@ erts_thr_progress_fatal_error_wait(SWord timeout) { erts_aint32_t bc; SWord time_left = timeout; ErtsMonotonicTime timeout_time; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); /* * Counting poll intervals may give us a too long timeout @@ -1367,7 +1368,7 @@ erts_thr_progress_fatal_error_wait(SWord timeout) { * this. In case we havn't got time correction this may * however fail too... */ - timeout_time = erts_get_monotonic_time(); + timeout_time = erts_get_monotonic_time(esdp); timeout_time += ERTS_MSEC_TO_MONOTONIC((ErtsMonotonicTime) timeout); while (1) { @@ -1378,7 +1379,7 @@ erts_thr_progress_fatal_error_wait(SWord timeout) { break; /* Succefully blocked all managed threads */ if (time_left <= 0) break; /* Timeout */ - if (timeout_time <= erts_get_monotonic_time()) + if (timeout_time <= erts_get_monotonic_time(esdp)) break; /* Timeout */ } } diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index cb7764addc..4560cd23af 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -20,73 +20,39 @@ #ifndef ERL_TIME_H__ #define ERL_TIME_H__ +/* timer wheel size NEED to be a power of 2 */ +#ifdef SMALL_MEMORY +#define ERTS_TIW_SIZE (1 << 13) +#else +#define ERTS_TIW_SIZE (1 << 16) +#endif + #if defined(DEBUG) || 0 #define ERTS_TIME_ASSERT(B) ERTS_ASSERT(B) #else #define ERTS_TIME_ASSERT(B) ((void) 1) #endif +typedef enum { + ERTS_NO_TIME_WARP_MODE, + ERTS_SINGLE_TIME_WARP_MODE, + ERTS_MULTI_TIME_WARP_MODE +} ErtsTimeWarpMode; + typedef struct ErtsTimerWheel_ ErtsTimerWheel; -typedef erts_atomic64_t * ErtsNextTimeoutRef; -extern ErtsTimerWheel *erts_default_timer_wheel; +typedef ErtsMonotonicTime * ErtsNextTimeoutRef; extern SysTimeval erts_first_emu_time; -/* -** Timer entry: -*/ -typedef struct erl_timer { - struct erl_timer* next; /* next entry tiw slot or chain */ - struct erl_timer* prev; /* prev entry tiw slot or chain */ - Uint slot; /* slot in timer wheel */ - erts_smp_atomic_t wheel; - ErtsMonotonicTime timeout_pos; /* Timeout in absolute clock ticks */ - /* called when timeout */ - void (*timeout)(void*); - /* called when cancel (may be NULL) */ - void (*cancel)(void*); - void* arg; /* argument to timeout/cancel procs */ -} ErlTimer; - -typedef void (*ErlTimeoutProc)(void*); -typedef void (*ErlCancelProc)(void*); - -#ifdef ERTS_SMP -/* - * Process and port timer - */ -typedef union ErtsSmpPTimer_ ErtsSmpPTimer; -union ErtsSmpPTimer_ { - struct { - ErlTimer tm; - Eterm id; - void (*timeout_func)(void*); - ErtsSmpPTimer **timer_ref; - Uint32 flags; - } timer; - ErtsSmpPTimer *next; -}; - -void erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, - Eterm id, - ErlTimeoutProc timeout_func, - Uint timeout); -void erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer); -#endif void erts_monitor_time_offset(Eterm id, Eterm ref); int erts_demonitor_time_offset(Eterm ref); +int erts_init_time_sup(int, ErtsTimeWarpMode); void erts_late_init_time_sup(void); -/* timer-wheel api */ - -ErtsTimerWheel *erts_create_timer_wheel(int); ErtsNextTimeoutRef erts_get_next_timeout_reference(ErtsTimerWheel *); void erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode); -void erts_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); -void erts_cancel_timer(ErlTimer*); -Uint erts_time_left(ErlTimer *); void erts_bump_timers(ErtsTimerWheel *, ErtsMonotonicTime); Uint erts_timer_wheel_memory_size(void); @@ -94,27 +60,6 @@ Uint erts_timer_wheel_memory_size(void); void erts_p_slpq(void); #endif -ErtsMonotonicTime erts_check_next_timeout_time(ErtsTimerWheel *, - ErtsMonotonicTime); - -ERTS_GLB_INLINE void erts_init_timer(ErlTimer *p); -ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE void erts_init_timer(ErlTimer *p) -{ - erts_smp_atomic_init_nob(&p->wheel, (erts_aint_t) NULL); -} - -ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef nxt_tmo_ref) -{ - return (ErtsMonotonicTime) erts_atomic64_read_acqb((erts_atomic64_t *) nxt_tmo_ref); -} - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - - /* time_sup */ #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) @@ -147,6 +92,7 @@ ErtsTimeOffsetState erts_time_offset_state(void); ErtsTimeOffsetState erts_finalize_time_offset(void); struct process; Eterm erts_get_monotonic_start_time(struct process *c_p); +Eterm erts_get_monotonic_end_time(struct process *c_p); Eterm erts_monotonic_time_source(struct process*c_p); Eterm erts_system_time_source(struct process*c_p); @@ -156,8 +102,20 @@ Eterm erts_system_time_source(struct process*c_p); #define ERTS_CLKTCK_RESOLUTION (erts_time_sup__.r.o.clktck_resolution) #endif +#define ERTS_TIMER_WHEEL_MSEC (ERTS_TIW_SIZE/(ERTS_CLKTCK_RESOLUTION/1000)) + struct erts_time_sup_read_only__ { ErtsMonotonicTime monotonic_time_unit; +#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT + ErtsMonotonicTime start; + struct { + ErtsMonotonicTime native; + ErtsMonotonicTime nsec; + ErtsMonotonicTime usec; + ErtsMonotonicTime msec; + ErtsMonotonicTime sec; + } start_offset; +#endif #ifndef SYS_CLOCK_RESOLUTION ErtsMonotonicTime clktck_resolution; #endif @@ -213,6 +171,16 @@ erts_time_unit_conversion(Uint64 value, #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ +/* + * Range of monotonic time internally + */ + +#define ERTS_MONOTONIC_BEGIN \ + ERTS_MONOTONIC_TIME_UNIT +#define ERTS_MONOTONIC_END \ + ((ERTS_MONOTONIC_TIME_MAX / ERTS_MONOTONIC_TIME_UNIT) \ + * ERTS_MONOTONIC_TIME_UNIT) + #if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT /* @@ -224,9 +192,6 @@ erts_time_unit_conversion(Uint64 value, # error Compile time time unit needs to be at least 1000000 #endif -#define ERTS_MONOTONIC_TIME_UNIT \ - ((ErtsMonotonicTime) ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT) - #if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000*1000 /* Nano-second time unit */ @@ -257,6 +222,66 @@ erts_time_unit_conversion(Uint64 value, #error Missing implementation for monotonic time unit #endif +#define ERTS_MONOTONIC_TIME_UNIT \ + ((ErtsMonotonicTime) ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT) + +/* + * NOTE! ERTS_MONOTONIC_TIME_START_EXTERNAL *need* to be a multiple + * of ERTS_MONOTONIC_TIME_UNIT. + */ + +#ifdef ARCH_32 +/* + * Want to use a big-num of arity 2 as long as possible (584 years + * in the nano-second time unit case). + */ +#define ERTS_MONOTONIC_TIME_START_EXTERNAL \ + (((((((ErtsMonotonicTime) 1) << 32)-1) \ + / ERTS_MONOTONIC_TIME_UNIT) \ + * ERTS_MONOTONIC_TIME_UNIT) \ + + ERTS_MONOTONIC_TIME_UNIT) + +#else /* ARCH_64 */ + +#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT <= 10*1000*1000 + +/* + * Using micro second time unit or lower. Start at zero since + * time will remain an immediate for a very long time anyway + * (1827 years in the 10 micro second case)... + */ +#define ERTS_MONOTONIC_TIME_START_EXTERNAL ((ErtsMonotonicTime) 0) + +#else /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 10*1000*1000 */ + +/* + * Want to use an immediate as long as possible (36 years in the + * nano-second time unit case). +*/ +#define ERTS_MONOTONIC_TIME_START_EXTERNAL \ + ((((ErtsMonotonicTime) MIN_SMALL) \ + / ERTS_MONOTONIC_TIME_UNIT) \ + * ERTS_MONOTONIC_TIME_UNIT) + +#endif /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 1000*1000 */ + +#endif /* ARCH_64 */ + +/* + * Offsets from internal monotonic time to external monotonic time + */ + +#define ERTS_MONOTONIC_OFFSET_NATIVE \ + (ERTS_MONOTONIC_TIME_START_EXTERNAL - ERTS_MONOTONIC_BEGIN) +#define ERTS_MONOTONIC_OFFSET_NSEC \ + ERTS_MONOTONIC_TO_NSEC__(ERTS_MONOTONIC_OFFSET_NATIVE) +#define ERTS_MONOTONIC_OFFSET_USEC \ + ERTS_MONOTONIC_TO_USEC__(ERTS_MONOTONIC_OFFSET_NATIVE) +#define ERTS_MONOTONIC_OFFSET_MSEC \ + ERTS_MONOTONIC_TO_MSEC__(ERTS_MONOTONIC_OFFSET_NATIVE) +#define ERTS_MONOTONIC_OFFSET_SEC \ + ERTS_MONOTONIC_TO_SEC__(ERTS_MONOTONIC_OFFSET_NATIVE) + #define ERTS_MONOTONIC_TO_CLKTCKS__(MON) \ ((MON) / (ERTS_MONOTONIC_TIME_UNIT/ERTS_CLKTCK_RESOLUTION)) #define ERTS_CLKTCKS_TO_MONOTONIC__(TCKS) \ @@ -264,8 +289,23 @@ erts_time_unit_conversion(Uint64 value, #else /* !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */ +/* + * Initialized in erts_init_sys_time_sup() + */ #define ERTS_MONOTONIC_TIME_UNIT (erts_time_sup__.r.o.monotonic_time_unit) +/* + * Offsets from internal monotonic time to external monotonic time + * + * Initialized in erts_init_time_sup()... + */ +#define ERTS_MONOTONIC_TIME_START_EXTERNAL (erts_time_sup__.r.o.start) +#define ERTS_MONOTONIC_OFFSET_NATIVE (erts_time_sup__.r.o.start_offset.native) +#define ERTS_MONOTONIC_OFFSET_NSEC (erts_time_sup__.r.o.start_offset.nsec) +#define ERTS_MONOTONIC_OFFSET_USEC (erts_time_sup__.r.o.start_offset.usec) +#define ERTS_MONOTONIC_OFFSET_MSEC (erts_time_sup__.r.o.start_offset.msec) +#define ERTS_MONOTONIC_OFFSET_SEC (erts_time_sup__.r.o.start_offset.sec) + #define ERTS_CONV_FROM_MON_UNIT___(M, TO) \ ((ErtsMonotonicTime) \ erts_time_unit_conversion((Uint64) (M), \ @@ -303,6 +343,10 @@ erts_time_unit_conversion(Uint64 value, #endif /* !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */ +#define ERTS_MONOTONIC_TIME_END_EXTERNAL \ + (ERTS_MONOTONIC_TIME_START_EXTERNAL \ + + (ERTS_MONOTONIC_END - ERTS_MONOTONIC_BEGIN)) + #define ERTS_MSEC_TO_CLKTCKS__(MON) \ ((MON) * (ERTS_CLKTCK_RESOLUTION/1000)) #define ERTS_CLKTCKS_TO_MSEC__(TCKS) \ @@ -348,3 +392,65 @@ erts_time_unit_conversion(Uint64 value, ERTS_CLKTCKS_TO_MSEC__((X))) #endif /* ERL_TIME_H__ */ + +/* timer-wheel api */ +#if defined(ERTS_WANT_TIMER_WHEEL_API) && !defined(ERTS_GOT_TIMER_WHEEL_API) +#define ERTS_GOT_TIMER_WHEEL_API + +#include "erl_thr_progress.h" +#include "erl_process.h" + +void erts_sched_init_time_sup(ErtsSchedulerData *esdp); + + +#define ERTS_TWHEEL_SLOT_AT_ONCE -1 +#define ERTS_TWHEEL_SLOT_INACTIVE -2 + +/* +** Timer entry: +*/ +typedef struct erl_timer { + struct erl_timer* next; /* next entry tiw slot or chain */ + struct erl_timer* prev; /* prev entry tiw slot or chain */ + union { + struct { + void (*timeout)(void*); /* called when timeout */ + void (*cancel)(void*); /* called when cancel (may be NULL) */ + void* arg; /* argument to timeout/cancel procs */ + } func; + ErtsThrPrgrLaterOp cleanup; + } u; + ErtsMonotonicTime timeout_pos; /* Timeout in absolute clock ticks */ + int slot; +} ErtsTWheelTimer; + +typedef void (*ErlTimeoutProc)(void*); +typedef void (*ErlCancelProc)(void*); + +void erts_twheel_set_timer(ErtsTimerWheel *tiw, + ErtsTWheelTimer *p, ErlTimeoutProc timeout, + ErlCancelProc cancel, void *arg, + ErtsMonotonicTime timeout_pos); +void erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p); +ErtsTimerWheel *erts_create_timer_wheel(ErtsSchedulerData *esdp); + +ErtsMonotonicTime erts_check_next_timeout_time(ErtsSchedulerData *); + +ERTS_GLB_INLINE void erts_twheel_init_timer(ErtsTWheelTimer *p); +ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void erts_twheel_init_timer(ErtsTWheelTimer *p) +{ + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; +} + +ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef nxt_tmo_ref) +{ + return *((ErtsMonotonicTime *) nxt_tmo_ref); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* timer wheel api */ diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 9a7466ff48..e550c999b8 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -30,6 +30,8 @@ #include "sys.h" #include "erl_vm.h" #include "global.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" static erts_smp_mtx_t erts_timeofday_mtx; static erts_smp_mtx_t erts_get_time_mtx; @@ -57,82 +59,13 @@ static int time_sup_initialized = 0; static void schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset); -/* - * NOTE! ERTS_MONOTONIC_TIME_START *need* to be a multiple - * of ERTS_MONOTONIC_TIME_UNIT. - */ - -#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT - -#ifdef ARCH_32 -/* - * Want to use a big-num of arity 2 as long as possible (584 years - * in the nano-second time unit case). - */ -#define ERTS_MONOTONIC_TIME_START \ - (((((((ErtsMonotonicTime) 1) << 32)-1) \ - / ERTS_MONOTONIC_TIME_UNIT) \ - * ERTS_MONOTONIC_TIME_UNIT) \ - + ERTS_MONOTONIC_TIME_UNIT) - -#else /* ARCH_64 */ - -#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT <= 10*1000*1000 - -/* - * Using micro second time unit or lower. Start at zero since - * time will remain an immediate for a very long time anyway - * (1827 years in the 10 micro second case)... - */ -#define ERTS_MONOTONIC_TIME_START ((ErtsMonotonicTime) 0) - -#else /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 1000*1000 */ - -/* - * Want to use an immediate as long as possible (36 years in the - * nano-second time unit case). -*/ -#define ERTS_MONOTONIC_TIME_START \ - ((((ErtsMonotonicTime) MIN_SMALL) \ - / ERTS_MONOTONIC_TIME_UNIT) \ - * ERTS_MONOTONIC_TIME_UNIT) - -#endif /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 1000*1000 */ - -#endif /* ARCH_64 */ - -#define ERTS_MONOTONIC_OFFSET_NATIVE \ - (ERTS_MONOTONIC_TIME_START - ERTS_MONOTONIC_TIME_UNIT) -#define ERTS_MONOTONIC_OFFSET_NSEC \ - ERTS_MONOTONIC_TO_NSEC__(ERTS_MONOTONIC_OFFSET_NATIVE) -#define ERTS_MONOTONIC_OFFSET_USEC \ - ERTS_MONOTONIC_TO_USEC__(ERTS_MONOTONIC_OFFSET_NATIVE) -#define ERTS_MONOTONIC_OFFSET_MSEC \ - ERTS_MONOTONIC_TO_MSEC__(ERTS_MONOTONIC_OFFSET_NATIVE) -#define ERTS_MONOTONIC_OFFSET_SEC \ - ERTS_MONOTONIC_TO_SEC__(ERTS_MONOTONIC_OFFSET_NATIVE) - -#else /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */ - -/* - * Initialized in erts_init_time_sup()... - */ - -#define ERTS_MONOTONIC_TIME_START (time_sup.r.o.start) -#define ERTS_MONOTONIC_OFFSET_NATIVE (time_sup.r.o.start_offset.native) -#define ERTS_MONOTONIC_OFFSET_NSEC (time_sup.r.o.start_offset.nsec) -#define ERTS_MONOTONIC_OFFSET_USEC (time_sup.r.o.start_offset.usec) -#define ERTS_MONOTONIC_OFFSET_MSEC (time_sup.r.o.start_offset.msec) -#define ERTS_MONOTONIC_OFFSET_SEC (time_sup.r.o.start_offset.sec) - -#endif /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */ - struct time_sup_read_only__ { ErtsMonotonicTime (*get_time)(void); int correction; ErtsTimeWarpMode warp_mode; #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT ErtsMonotonicTime moffset; + int os_corrected_monotonic_time; int os_monotonic_time_disable; char *os_monotonic_time_func; char *os_monotonic_time_clock_id; @@ -145,26 +78,20 @@ struct time_sup_read_only__ { int os_system_time_locked; Uint64 os_system_time_resolution; Uint64 os_system_time_extended; -#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT - ErtsMonotonicTime start; - struct { - ErtsMonotonicTime native; - ErtsMonotonicTime nsec; - ErtsMonotonicTime usec; - ErtsMonotonicTime msec; - ErtsMonotonicTime sec; - } start_offset; -#endif struct { ErtsMonotonicTime large_diff; ErtsMonotonicTime small_diff; } adj; + struct { + ErtsMonotonicTime error; + ErtsMonotonicTime resolution; + int intervals; + int use_avg; + } drift_adj; }; typedef struct { -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC ErtsMonotonicTime drift; /* Correction for os monotonic drift */ -#endif ErtsMonotonicTime error; /* Correction for error between system times */ } ErtsMonotonicCorrection; @@ -174,7 +101,7 @@ typedef struct { ErtsMonotonicCorrection correction; } ErtsMonotonicCorrectionInstance; -#define ERTS_DRIFT_INTERVALS 5 +#define ERTS_MAX_DRIFT_INTERVALS 50 typedef struct { struct { struct { @@ -185,7 +112,7 @@ typedef struct { ErtsMonotonicTime sys; ErtsMonotonicTime mon; } time; - } intervals[ERTS_DRIFT_INTERVALS]; + } intervals[ERTS_MAX_DRIFT_INTERVALS]; struct { ErtsMonotonicTime sys; ErtsMonotonicTime mon; @@ -197,9 +124,7 @@ typedef struct { typedef struct { ErtsMonotonicCorrectionInstance prev; ErtsMonotonicCorrectionInstance curr; -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC ErtsMonotonicDriftData drift; -#endif ErtsMonotonicTime last_check; int short_check_interval; } ErtsMonotonicCorrectionData; @@ -208,15 +133,16 @@ struct time_sup_infrequently_changed__ { #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT struct { erts_smp_rwmtx_t rwmtx; - ErlTimer timer; + ErtsTWheelTimer timer; ErtsMonotonicCorrectionData cdata; } parmon; ErtsMonotonicTime minit; #endif - int finalized_offset; ErtsSystemTime sinit; ErtsMonotonicTime not_corrected_moffset; - erts_atomic64_t offset; + erts_smp_atomic64_t offset; + ErtsMonotonicTime shadow_offset; + erts_smp_atomic32_t preliminary_offset; }; struct time_sup_frequently_changed__ { @@ -254,21 +180,32 @@ erts_get_approx_time(void) static ERTS_INLINE void init_time_offset(ErtsMonotonicTime offset) { - erts_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset); + erts_smp_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset); } static ERTS_INLINE void set_time_offset(ErtsMonotonicTime offset) { - erts_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset); + erts_smp_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset); } static ERTS_INLINE ErtsMonotonicTime get_time_offset(void) { - return (ErtsMonotonicTime) erts_atomic64_read_acqb(&time_sup.inf.c.offset); + return (ErtsMonotonicTime) erts_smp_atomic64_read_acqb(&time_sup.inf.c.offset); } +static ERTS_INLINE void +update_last_mtime(ErtsSchedulerData *esdp, ErtsMonotonicTime mtime) +{ + if (!esdp) + esdp = erts_get_scheduler_data(); + if (esdp) { + ASSERT(mtime >= esdp->last_monotonic_time); + esdp->last_monotonic_time = mtime; + esdp->check_time_reds = 0; + } +} #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT @@ -290,16 +227,38 @@ get_time_offset(void) #define ERTS_TIME_DRIFT_MAX_ADJ_DIFF ERTS_USEC_TO_MONOTONIC(50) #define ERTS_TIME_DRIFT_MIN_ADJ_DIFF ERTS_USEC_TO_MONOTONIC(5) +/* + * Maximum drift of the OS monotonic clock expected. + * + * We use 1 milli second per second. If the monotonic + * clock drifts more than this we will fail to adjust for + * drift, and error correction will kick in instead. + * If it is larger than this, one could argue that the + * primitive is to poor to be used... + */ +#define ERTS_MAX_MONOTONIC_DRIFT ERTS_MSEC_TO_MONOTONIC(1) + +/* + * We assume that precision is 32 times worse than the + * resolution. This is a wild guess, but there are no + * practical way to determine actual precision. + */ +#define ERTS_ASSUMED_PRECISION_DROP 32 + +#define ERTS_MIN_MONOTONIC_DRIFT_MEASUREMENT \ + (ERTS_SHORT_TIME_CORRECTION_CHECK - 2*ERTS_MAX_MONOTONIC_DRIFT) + + static ERTS_INLINE ErtsMonotonicTime calc_corrected_erl_mtime(ErtsMonotonicTime os_mtime, ErtsMonotonicCorrectionInstance *cip, - ErtsMonotonicTime *os_mdiff_p) + ErtsMonotonicTime *os_mdiff_p, + int os_drift_corrected) { ErtsMonotonicTime erl_mtime, diff = os_mtime - cip->os_mtime; ERTS_TIME_ASSERT(diff >= 0); -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC - diff += (cip->correction.drift*diff)/ERTS_MONOTONIC_TIME_UNIT; -#endif + if (!os_drift_corrected) + diff += (cip->correction.drift*diff)/ERTS_MONOTONIC_TIME_UNIT; erl_mtime = cip->erl_mtime; erl_mtime += diff; erl_mtime += cip->correction.error*(diff/ERTS_TCORR_ERR_UNIT); @@ -308,7 +267,8 @@ calc_corrected_erl_mtime(ErtsMonotonicTime os_mtime, return erl_mtime; } -static ErtsMonotonicTime get_corrected_time(void) +static ERTS_INLINE ErtsMonotonicTime +read_corrected_time(int os_drift_corrected) { ErtsMonotonicTime os_mtime; ErtsMonotonicCorrectionData cdata; @@ -331,7 +291,18 @@ static ErtsMonotonicTime get_corrected_time(void) cip = &cdata.prev; } - return calc_corrected_erl_mtime(os_mtime, cip, NULL); + return calc_corrected_erl_mtime(os_mtime, cip, NULL, + os_drift_corrected); +} + +static ErtsMonotonicTime get_os_drift_corrected_time(void) +{ + return read_corrected_time(!0); +} + +static ErtsMonotonicTime get_corrected_time(void) +{ + return read_corrected_time(0); } #ifdef ERTS_TIME_CORRECTION_PRINT @@ -352,66 +323,53 @@ print_correction(int change, usec_sdiff = ERTS_MONOTONIC_TO_USEC(sdiff); if (!change) - fprintf(stderr, - "sdiff = %lld usec : [ec=%lld ppm, dc=%lld ppb] : " - "tmo = %lld msec\r\n", - (long long) usec_sdiff, - (long long) (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT, - (long long) (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT, - (long long) tmo); + erts_fprintf(stderr, + "sdiff = %b64d usec : [ec=%b64d ppm, dc=%b64d ppb] : " + "tmo = %bpu msec\r\n", + usec_sdiff, + (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT, + (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT, + tmo); else - fprintf(stderr, - "sdiff = %lld usec : [ec=%lld ppm, dc=%lld ppb] " - "-> [ec=%lld ppm, dc=%lld ppb] : tmo = %lld msec\r\n", - (long long) usec_sdiff, - (long long) (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT, - (long long) (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT, - (long long) (1000000*new_ecorr) / ERTS_TCORR_ERR_UNIT, - (long long) (1000000000*new_dcorr) / ERTS_MONOTONIC_TIME_UNIT, - (long long) tmo); - + erts_fprintf(stderr, + "sdiff = %b64d usec : [ec=%b64d ppm, dc=%b64d ppb] " + "-> [ec=%b64d ppm, dc=%b64d ppb] : tmo = %bpu msec\r\n", + usec_sdiff, + (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT, + (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT, + (1000000*new_ecorr) / ERTS_TCORR_ERR_UNIT, + (1000000000*new_dcorr) / ERTS_MONOTONIC_TIME_UNIT, + tmo); } #endif +static ERTS_INLINE ErtsMonotonicTime +get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime tmo) +{ + ErtsMonotonicTime tpos; + tpos = ERTS_MONOTONIC_TO_CLKTCKS(now - 1); + tpos += ERTS_MSEC_TO_CLKTCKS(tmo); + tpos += 1; + return tpos; +} + static void -check_time_correction(void *unused) +check_time_correction(void *vesdp) { -#ifndef ERTS_TIME_CORRECTION_PRINT -# define ERTS_PRINT_CORRECTION -#else -# ifdef ERTS_HAVE_CORRECTED_OS_MONOTONIC -# define ERTS_PRINT_CORRECTION \ - print_correction(set_new_correction, \ - sdiff, \ - cip->correction.error, \ - 0, \ - new_correction.error, \ - 0, \ - timeout) -# else -# define ERTS_PRINT_CORRECTION \ - print_correction(set_new_correction, \ - sdiff, \ - cip->correction.error, \ - cip->correction.drift, \ - new_correction.error, \ - new_correction.drift, \ - timeout) -# endif -#endif + int init_drift_adj = !vesdp; + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; ErtsMonotonicCorrectionData cdata; ErtsMonotonicCorrection new_correction; ErtsMonotonicCorrectionInstance *cip; ErtsMonotonicTime mdiff, sdiff, os_mtime, erl_mtime, os_stime, - erl_stime, time_offset; + erl_stime, time_offset, timeout_pos; Uint timeout; - int set_new_correction, begin_short_intervals = 0; + int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time; + int set_new_correction = 0, begin_short_intervals = 0; erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx); - ASSERT(time_sup.inf.c.finalized_offset); - erts_os_times(&os_mtime, &os_stime); cdata = time_sup.inf.c.parmon.cdata; @@ -423,14 +381,23 @@ check_time_correction(void *unused) "OS monotonic time stepped backwards\n"); cip = &cdata.curr; - erl_mtime = calc_corrected_erl_mtime(os_mtime, cip, &mdiff); + erl_mtime = calc_corrected_erl_mtime(os_mtime, cip, &mdiff, + os_drift_corrected); time_offset = get_time_offset(); erl_stime = erl_mtime + time_offset; sdiff = erl_stime - os_stime; + if (time_sup.inf.c.shadow_offset) { + ERTS_TIME_ASSERT(time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE); + if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) + sdiff += time_sup.inf.c.shadow_offset; + else + time_sup.inf.c.shadow_offset = 0; + } + new_correction = cip->correction; - + if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE && (sdiff < -2*time_sup.r.o.adj.small_diff || 2*time_sup.r.o.adj.small_diff < sdiff)) { @@ -440,9 +407,24 @@ check_time_correction(void *unused) set_time_offset(time_offset); schedule_send_time_offset_changed_notifications(time_offset); begin_short_intervals = 1; - if (cdata.curr.correction.error == 0) - set_new_correction = 0; - else { + if (cdata.curr.correction.error != 0) { + set_new_correction = 1; + new_correction.error = 0; + } + } + else if ((time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE + && erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) + && (sdiff < -2*time_sup.r.o.adj.small_diff + || 2*time_sup.r.o.adj.small_diff < sdiff)) { + /* + * System time diff exeeded limits; change shadow offset + * and let OS system time leap away from Erlang system + * time. + */ + time_sup.inf.c.shadow_offset -= sdiff; + sdiff = 0; + begin_short_intervals = 1; + if (cdata.curr.correction.error != 0) { set_new_correction = 1; new_correction.error = 0; } @@ -462,16 +444,11 @@ check_time_correction(void *unused) else new_correction.error = -ERTS_TCORR_ERR_SMALL_ADJ; } - else { - set_new_correction = 0; - } } else if (cdata.curr.correction.error > 0) { if (sdiff < 0) { - if (cdata.curr.correction.error == ERTS_TCORR_ERR_LARGE_ADJ - || -time_sup.r.o.adj.large_diff <= sdiff) - set_new_correction = 0; - else { + if (cdata.curr.correction.error != ERTS_TCORR_ERR_LARGE_ADJ + && sdiff < -time_sup.r.o.adj.large_diff) { new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ; set_new_correction = 1; } @@ -490,14 +467,11 @@ check_time_correction(void *unused) } else /* if (cdata.curr.correction.error < 0) */ { if (0 < sdiff) { - if (cdata.curr.correction.error == -ERTS_TCORR_ERR_LARGE_ADJ - || sdiff <= time_sup.r.o.adj.large_diff) - set_new_correction = 0; - else { + if (cdata.curr.correction.error != -ERTS_TCORR_ERR_LARGE_ADJ + && time_sup.r.o.adj.large_diff < sdiff) { new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ; set_new_correction = 1; } - set_new_correction = 0; } else if (sdiff < -time_sup.r.o.adj.small_diff) { set_new_correction = 1; @@ -512,8 +486,7 @@ check_time_correction(void *unused) } } -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC - { + if (!os_drift_corrected) { ErtsMonotonicDriftData *ddp = &time_sup.inf.c.parmon.cdata.drift; int ix = ddp->ix; ErtsMonotonicTime mtime_diff, old_os_mtime; @@ -521,25 +494,26 @@ check_time_correction(void *unused) old_os_mtime = ddp->intervals[ix].time.mon; mtime_diff = os_mtime - old_os_mtime; - if (mtime_diff >= ERTS_SEC_TO_MONOTONIC(10)) { + if ((mtime_diff >= ERTS_MIN_MONOTONIC_DRIFT_MEASUREMENT) + | init_drift_adj) { ErtsMonotonicTime drift_adj, drift_adj_diff, old_os_stime, - stime_diff, mtime_acc, stime_acc, avg_drift_adj; + smtime_diff, stime_diff, mtime_acc, stime_acc, + avg_drift_adj, max_drift; old_os_stime = ddp->intervals[ix].time.sys; mtime_acc = ddp->acc.mon; stime_acc = ddp->acc.sys; - avg_drift_adj = (((stime_acc - mtime_acc)*ERTS_MONOTONIC_TIME_UNIT) + avg_drift_adj = (((stime_acc - mtime_acc) + * ERTS_MONOTONIC_TIME_UNIT) / mtime_acc); mtime_diff = os_mtime - old_os_mtime; stime_diff = os_stime - old_os_stime; - drift_adj = (((stime_diff - mtime_diff)*ERTS_MONOTONIC_TIME_UNIT) - / mtime_diff); - + smtime_diff = stime_diff - mtime_diff; ix++; - if (ix >= ERTS_DRIFT_INTERVALS) + if (ix >= time_sup.r.o.drift_adj.intervals) ix = 0; mtime_acc -= ddp->intervals[ix].diff.mon; mtime_acc += mtime_diff; @@ -555,24 +529,50 @@ check_time_correction(void *unused) ddp->acc.mon = mtime_acc; ddp->acc.sys = stime_acc; - drift_adj_diff = avg_drift_adj - drift_adj; - if (drift_adj_diff < -ERTS_TIME_DRIFT_MAX_ADJ_DIFF - || ERTS_TIME_DRIFT_MAX_ADJ_DIFF < drift_adj_diff) { - ddp->dirty_counter = ERTS_DRIFT_INTERVALS; + max_drift = ERTS_MAX_MONOTONIC_DRIFT; + max_drift *= ERTS_MONOTONIC_TO_SEC(mtime_diff); + + if (smtime_diff > time_sup.r.o.drift_adj.error + max_drift + || smtime_diff < -1*time_sup.r.o.drift_adj.error - max_drift) { + dirty_intervals: + /* + * We had a leap in system time. Mark array as + * dirty to ensure that dirty values are rotated + * out before we use it again... + */ + ddp->dirty_counter = time_sup.r.o.drift_adj.intervals; begin_short_intervals = 1; } - else { - if (ddp->dirty_counter <= 0) { - drift_adj = ((stime_acc - mtime_acc) - *ERTS_MONOTONIC_TIME_UNIT) / mtime_acc; + else if (ddp->dirty_counter > 0) { + if (init_drift_adj) { + new_correction.drift = ((smtime_diff + * ERTS_MONOTONIC_TIME_UNIT) + / mtime_diff); + set_new_correction = 1; } - if (ddp->dirty_counter >= 0) { - if (ddp->dirty_counter == 0) { - /* Force set new drift correction... */ - set_new_correction = 1; - } + ddp->dirty_counter--; + } + else { + if (ddp->dirty_counter == 0) { + /* Force set new drift correction... */ + set_new_correction = 1; ddp->dirty_counter--; } + + if (time_sup.r.o.drift_adj.use_avg) + drift_adj = (((stime_acc - mtime_acc) + * ERTS_MONOTONIC_TIME_UNIT) + / mtime_acc); + else + drift_adj = ((smtime_diff + * ERTS_MONOTONIC_TIME_UNIT) + / mtime_diff); + + drift_adj_diff = avg_drift_adj - drift_adj; + if (drift_adj_diff < -ERTS_TIME_DRIFT_MAX_ADJ_DIFF + || ERTS_TIME_DRIFT_MAX_ADJ_DIFF < drift_adj_diff) + goto dirty_intervals; + drift_adj_diff = drift_adj - new_correction.drift; if (drift_adj_diff) { if (drift_adj_diff > ERTS_TIME_DRIFT_MAX_ADJ_DIFF) @@ -580,7 +580,6 @@ check_time_correction(void *unused) else if (drift_adj_diff < -ERTS_TIME_DRIFT_MAX_ADJ_DIFF) drift_adj_diff = -ERTS_TIME_DRIFT_MAX_ADJ_DIFF; new_correction.drift += drift_adj_diff; - if (drift_adj_diff < -ERTS_TIME_DRIFT_MIN_ADJ_DIFF || ERTS_TIME_DRIFT_MIN_ADJ_DIFF < drift_adj_diff) { set_new_correction = 1; @@ -589,7 +588,6 @@ check_time_correction(void *unused) } } } -#endif begin_short_intervals |= set_new_correction; @@ -608,25 +606,36 @@ check_time_correction(void *unused) timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK); else { ErtsMonotonicTime ecorr = new_correction.error; - if (sdiff < 0) - sdiff = -1*sdiff; + ErtsMonotonicTime abs_sdiff; + abs_sdiff = (sdiff < 0) ? -1*sdiff : sdiff; if (ecorr < 0) ecorr = -1*ecorr; - if (sdiff > ecorr*(ERTS_LONG_TIME_CORRECTION_CHECK/ERTS_TCORR_ERR_UNIT)) + if (abs_sdiff > ecorr*(ERTS_LONG_TIME_CORRECTION_CHECK/ERTS_TCORR_ERR_UNIT)) timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK); else { - timeout = ERTS_MONOTONIC_TO_MSEC((ERTS_TCORR_ERR_UNIT*sdiff)/ecorr); + timeout = ERTS_MONOTONIC_TO_MSEC((ERTS_TCORR_ERR_UNIT*abs_sdiff)/ecorr); if (timeout < 10) timeout = 10; } } if (timeout > ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK) - && time_sup.inf.c.parmon.cdata.short_check_interval) { + && (time_sup.inf.c.parmon.cdata.short_check_interval + || time_sup.inf.c.parmon.cdata.drift.dirty_counter >= 0)) { timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK); } - ERTS_PRINT_CORRECTION; + timeout_pos = get_timeout_pos(erl_mtime, timeout); + +#ifdef ERTS_TIME_CORRECTION_PRINT + print_correction(set_new_correction, + sdiff, + cip->correction.error, + cip->correction.drift, + new_correction.error, + new_correction.drift, + timeout); +#endif if (set_new_correction) { erts_smp_rwmtx_rwlock(&time_sup.inf.c.parmon.rwmtx); @@ -638,16 +647,17 @@ check_time_correction(void *unused) /* * Current correction instance begin when - * OS monotonic time has increased one unit. + * OS monotonic time has increased two units. */ - os_mtime++; + os_mtime += 2; /* * Erlang monotonic time corresponding to * next OS monotonic time using previous * correction. */ - erl_mtime = calc_corrected_erl_mtime(os_mtime, cip, NULL); + erl_mtime = calc_corrected_erl_mtime(os_mtime, cip, NULL, + os_drift_corrected); /* * Save new current correction instance. @@ -659,23 +669,74 @@ check_time_correction(void *unused) erts_smp_rwmtx_rwunlock(&time_sup.inf.c.parmon.rwmtx); } - erts_set_timer(&time_sup.inf.c.parmon.timer, - check_time_correction, - NULL, - NULL, - timeout); + if (!esdp) + esdp = erts_get_scheduler_data(); -#undef ERTS_PRINT_CORRECTION + erts_twheel_set_timer(esdp->timer_wheel, + &time_sup.inf.c.parmon.timer, + check_time_correction, + NULL, + (void *) esdp, + timeout_pos); } -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC +static ErtsMonotonicTime get_os_corrected_time(void) +{ + ASSERT(time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE); + return erts_os_monotonic_time() + time_sup.r.o.moffset; +} + +static void +check_time_offset(void *vesdp) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ErtsMonotonicTime sdiff, os_mtime, erl_mtime, os_stime, + erl_stime, time_offset, timeout, timeout_pos; + + ASSERT(time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE); + + erts_os_times(&os_mtime, &os_stime); + + erl_mtime = os_mtime + time_sup.r.o.moffset; + time_offset = get_time_offset(); + erl_stime = erl_mtime + time_offset; + + sdiff = erl_stime - os_stime; + + if ((sdiff < -2*time_sup.r.o.adj.small_diff + || 2*time_sup.r.o.adj.small_diff < sdiff)) { + /* System time diff exeeded limits; change time offset... */ +#ifdef ERTS_TIME_CORRECTION_PRINT + erts_fprintf(stderr, "sdiff = %b64d nsec -> 0 nsec\n", + ERTS_MONOTONIC_TO_NSEC(sdiff)); +#endif + time_offset -= sdiff; + sdiff = 0; + set_time_offset(time_offset); + schedule_send_time_offset_changed_notifications(time_offset); + } +#ifdef ERTS_TIME_CORRECTION_PRINT + else erts_fprintf(stderr, "sdiff = %b64d nsec\n", + ERTS_MONOTONIC_TO_NSEC(sdiff)); +#endif + + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK); + timeout_pos = get_timeout_pos(erl_mtime, timeout); + + erts_twheel_set_timer(esdp->timer_wheel, + &time_sup.inf.c.parmon.timer, + check_time_offset, + NULL, + vesdp, + timeout_pos); +} static void -init_check_time_correction(void *unused) +init_check_time_correction(void *vesdp) { ErtsMonotonicDriftData *ddp; ErtsMonotonicTime old_mtime, old_stime, mtime, stime, mtime_diff, - stime_diff; + stime_diff, smtime_diff, max_drift; int ix; ddp = &time_sup.inf.c.parmon.cdata.drift; @@ -687,7 +748,13 @@ init_check_time_correction(void *unused) mtime_diff = mtime - old_mtime; stime_diff = stime - old_stime; - if (100*stime_diff < 80*mtime_diff || 120*mtime_diff < 100*stime_diff ) { + smtime_diff = stime_diff - mtime_diff; + + max_drift = ERTS_MAX_MONOTONIC_DRIFT; + max_drift *= ERTS_MONOTONIC_TO_SEC(mtime_diff); + + if (smtime_diff > time_sup.r.o.drift_adj.error + max_drift + || smtime_diff < -1*time_sup.r.o.drift_adj.error - max_drift) { /* Had a system time leap... pretend no drift... */ stime_diff = mtime_diff; } @@ -697,29 +764,28 @@ init_check_time_correction(void *unused) * a drift adjustment, and repeat this interval * in all slots... */ - for (ix = 0; ix < ERTS_DRIFT_INTERVALS; ix++) { + for (ix = 0; ix < time_sup.r.o.drift_adj.intervals; ix++) { ddp->intervals[ix].diff.mon = mtime_diff; ddp->intervals[ix].diff.sys = stime_diff; ddp->intervals[ix].time.mon = old_mtime; ddp->intervals[ix].time.sys = old_stime; } - ddp->acc.sys = stime_diff*ERTS_DRIFT_INTERVALS; - ddp->acc.mon = mtime_diff*ERTS_DRIFT_INTERVALS; + ddp->acc.sys = stime_diff*time_sup.r.o.drift_adj.intervals; + ddp->acc.mon = mtime_diff*time_sup.r.o.drift_adj.intervals; ddp->ix = 0; - ddp->dirty_counter = ERTS_DRIFT_INTERVALS; + ddp->dirty_counter = time_sup.r.o.drift_adj.intervals; - check_time_correction(NULL); + check_time_correction(vesdp); } -#endif - static ErtsMonotonicTime finalize_corrected_time_offset(ErtsSystemTime *stimep) { ErtsMonotonicTime os_mtime; ErtsMonotonicCorrectionData cdata; ErtsMonotonicCorrectionInstance *cip; + int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time; erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx); @@ -734,25 +800,46 @@ finalize_corrected_time_offset(ErtsSystemTime *stimep) "OS monotonic time stepped backwards\n"); cip = &cdata.curr; - return calc_corrected_erl_mtime(os_mtime, cip, NULL); + return calc_corrected_erl_mtime(os_mtime, cip, NULL, + os_drift_corrected); } static void -late_init_time_correction(void) +late_init_time_correction(ErtsSchedulerData *esdp) { - if (time_sup.inf.c.finalized_offset) { + int quick_init_drift_adj; + void (*check_func)(void *); + ErtsMonotonicTime timeout, timeout_pos; - erts_init_timer(&time_sup.inf.c.parmon.timer); - erts_set_timer(&time_sup.inf.c.parmon.timer, -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC - init_check_time_correction, -#else - check_time_correction, -#endif - NULL, - NULL, - ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK)); + quick_init_drift_adj = + ERTS_MONOTONIC_TO_USEC(time_sup.r.o.drift_adj.error) == 0; + + if (quick_init_drift_adj) + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK/10); + else + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK); + + if (!time_sup.r.o.os_corrected_monotonic_time) + check_func = init_check_time_correction; + else if (time_sup.r.o.get_time == get_os_corrected_time) { + quick_init_drift_adj = 0; + check_func = check_time_offset; } + else + check_func = check_time_correction; + + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), + timeout); + + erts_twheel_init_timer(&time_sup.inf.c.parmon.timer); + erts_twheel_set_timer(esdp->timer_wheel, + &time_sup.inf.c.parmon.timer, + check_func, + NULL, + (quick_init_drift_adj + ? NULL + : esdp), + timeout_pos); } #endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */ @@ -832,6 +919,8 @@ void erts_init_sys_time_sup(void) #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT time_sup.r.o.os_monotonic_time_disable = !sys_init_time_res.have_os_monotonic_time; + time_sup.r.o.os_corrected_monotonic_time = + sys_init_time_res.have_corrected_os_monotonic_time; time_sup.r.o.os_monotonic_time_func = sys_init_time_res.os_monotonic_time_info.func; time_sup.r.o.os_monotonic_time_clock_id @@ -856,11 +945,13 @@ void erts_init_sys_time_sup(void) int erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) { - ErtsMonotonicTime resolution; + ErtsMonotonicTime resolution, ilength, intervals, short_isecs; #if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT ErtsMonotonicTime abs_native_offset, native_offset; #endif + erts_hl_timer_init(); + ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX); erts_smp_mtx_init(&erts_timeofday_mtx, "timeofday"); @@ -870,57 +961,62 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) time_sup.r.o.warp_mode = time_warp_mode; if (time_warp_mode == ERTS_SINGLE_TIME_WARP_MODE) - time_sup.inf.c.finalized_offset = 0; + erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 1); else - time_sup.inf.c.finalized_offset = ~0; + erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 0); + time_sup.inf.c.shadow_offset = 0; #if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT + /* + * NOTE! erts_time_sup__.r.o.start *need* to be a multiple + * of ERTS_MONOTONIC_TIME_UNIT. + */ + #ifdef ARCH_32 - time_sup.r.o.start = ((((ErtsMonotonicTime) 1) << 32)-1); - time_sup.r.o.start /= ERTS_MONOTONIC_TIME_UNIT; - time_sup.r.o.start *= ERTS_MONOTONIC_TIME_UNIT; - time_sup.r.o.start += ERTS_MONOTONIC_TIME_UNIT; - native_offset = time_sup.r.o.start - ERTS_MONOTONIC_TIME_UNIT; - native_offset = native_offset; + erts_time_sup__.r.o.start = ((((ErtsMonotonicTime) 1) << 32)-1); + erts_time_sup__.r.o.start /= ERTS_MONOTONIC_TIME_UNIT; + erts_time_sup__.r.o.start *= ERTS_MONOTONIC_TIME_UNIT; + erts_time_sup__.r.o.start += ERTS_MONOTONIC_TIME_UNIT; + native_offset = erts_time_sup__.r.o.start - ERTS_MONOTONIC_BEGIN; + abs_native_offset = native_offset; #else /* ARCH_64 */ if (ERTS_MONOTONIC_TIME_UNIT <= 10*1000*1000) { - time_sup.r.o.start = 0; - native_offset = -ERTS_MONOTONIC_TIME_UNIT; - abs_native_offset = ERTS_MONOTONIC_TIME_UNIT; + erts_time_sup__.r.o.start = 0; + native_offset = -ERTS_MONOTONIC_BEGIN; + abs_native_offset = ERTS_MONOTONIC_BEGIN; } else { - time_sup.r.o.start = ((ErtsMonotonicTime) MIN_SMALL); - time_sup.r.o.start /= ERTS_MONOTONIC_TIME_UNIT; - time_sup.r.o.start *= ERTS_MONOTONIC_TIME_UNIT; - native_offset = time_sup.r.o.start - ERTS_MONOTONIC_TIME_UNIT; + erts_time_sup__.r.o.start = ((ErtsMonotonicTime) MIN_SMALL); + erts_time_sup__.r.o.start /= ERTS_MONOTONIC_TIME_UNIT; + erts_time_sup__.r.o.start *= ERTS_MONOTONIC_TIME_UNIT; + native_offset = erts_time_sup__.r.o.start - ERTS_MONOTONIC_BEGIN; abs_native_offset = -1*native_offset; } #endif - time_sup.r.o.start_offset.native = (time_sup.r.o.start - - ERTS_MONOTONIC_TIME_UNIT); - time_sup.r.o.start_offset.nsec = (ErtsMonotonicTime) + erts_time_sup__.r.o.start_offset.native = native_offset; + erts_time_sup__.r.o.start_offset.nsec = (ErtsMonotonicTime) erts_time_unit_conversion((Uint64) abs_native_offset, (Uint32) ERTS_MONOTONIC_TIME_UNIT, (Uint32) 1000*1000*1000); - time_sup.r.o.start_offset.usec = (ErtsMonotonicTime) + erts_time_sup__.r.o.start_offset.usec = (ErtsMonotonicTime) erts_time_unit_conversion((Uint64) abs_native_offset, (Uint32) ERTS_MONOTONIC_TIME_UNIT, (Uint32) 1000*1000); - time_sup.r.o.start_offset.msec = (ErtsMonotonicTime) + erts_time_sup__.r.o.start_offset.msec = (ErtsMonotonicTime) erts_time_unit_conversion((Uint64) abs_native_offset, (Uint32) ERTS_MONOTONIC_TIME_UNIT, (Uint32) 1000); - time_sup.r.o.start_offset.sec = (ErtsMonotonicTime) + erts_time_sup__.r.o.start_offset.sec = (ErtsMonotonicTime) erts_time_unit_conversion((Uint64) abs_native_offset, (Uint32) ERTS_MONOTONIC_TIME_UNIT, (Uint32) 1); if (native_offset < 0) { - time_sup.r.o.start_offset.nsec *= -1; - time_sup.r.o.start_offset.usec *= -1; - time_sup.r.o.start_offset.msec *= -1; - time_sup.r.o.start_offset.sec *= -1; + erts_time_sup__.r.o.start_offset.nsec *= -1; + erts_time_sup__.r.o.start_offset.usec *= -1; + erts_time_sup__.r.o.start_offset.msec *= -1; + erts_time_sup__.r.o.start_offset.sec *= -1; } #endif @@ -938,17 +1034,66 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) time_sup.r.o.adj.large_diff = ERTS_USEC_TO_MONOTONIC(500); time_sup.r.o.adj.small_diff = time_sup.r.o.adj.large_diff/10; + time_sup.r.o.drift_adj.resolution = resolution; + + if (time_sup.r.o.os_corrected_monotonic_time) { + time_sup.r.o.drift_adj.use_avg = 0; + time_sup.r.o.drift_adj.intervals = 0; + time_sup.r.o.drift_adj.error = 0; + time_sup.inf.c.parmon.cdata.drift.dirty_counter = -1; + } + else { + /* + * Calculate length of the interval in seconds needed + * in order to get an error that is at most 1 micro second. + * If this interval is longer than the short time correction + * check interval we use the average of all values instead + * of the latest value. + */ + short_isecs = ERTS_MONOTONIC_TO_SEC(ERTS_SHORT_TIME_CORRECTION_CHECK); + ilength = ERTS_ASSUMED_PRECISION_DROP * ERTS_MONOTONIC_TIME_UNIT; + ilength /= (resolution * ERTS_USEC_TO_MONOTONIC(1)); + time_sup.r.o.drift_adj.use_avg = ilength > short_isecs; + + if (ilength == 0) + intervals = 5; + else { + intervals = ilength / short_isecs; + if (intervals > ERTS_MAX_DRIFT_INTERVALS) + intervals = ERTS_MAX_DRIFT_INTERVALS; + else if (intervals < 5) + intervals = 5; + } + time_sup.r.o.drift_adj.intervals = (int) intervals; + + /* + * drift_adj.error equals maximum assumed error + * over a short time interval. We use this value also + * when examining a large interval. In this case the + * error will be smaller, but we do not want to + * recalculate this over and over again. + */ + + time_sup.r.o.drift_adj.error = ERTS_MONOTONIC_TIME_UNIT; + time_sup.r.o.drift_adj.error *= ERTS_ASSUMED_PRECISION_DROP; + time_sup.r.o.drift_adj.error /= resolution * short_isecs; + } #ifdef ERTS_TIME_CORRECTION_PRINT - fprintf(stderr, "start = %lld\n\r", (long long) ERTS_MONOTONIC_TIME_START); - fprintf(stderr, "native offset = %lld\n\r", (long long) ERTS_MONOTONIC_OFFSET_NATIVE); - fprintf(stderr, "nsec offset = %lld\n\r", (long long) ERTS_MONOTONIC_OFFSET_NSEC); - fprintf(stderr, "usec offset = %lld\n\r", (long long) ERTS_MONOTONIC_OFFSET_USEC); - fprintf(stderr, "msec offset = %lld\n\r", (long long) ERTS_MONOTONIC_OFFSET_MSEC); - fprintf(stderr, "sec offset = %lld\n\r", (long long) ERTS_MONOTONIC_OFFSET_SEC); - fprintf(stderr, "large diff = %lld usec\r\n", - (long long) ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.large_diff)); - fprintf(stderr, "small diff = %lld usec\r\n", - (long long) ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.small_diff)); + erts_fprintf(stderr, "resolution = %b64d\n", resolution); + erts_fprintf(stderr, "adj large diff = %b64d usec\n", + ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.large_diff)); + erts_fprintf(stderr, "adj small diff = %b64d usec\n", + ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.small_diff)); + if (!time_sup.r.o.os_corrected_monotonic_time) { + erts_fprintf(stderr, "drift intervals = %d\n", + time_sup.r.o.drift_adj.intervals); + erts_fprintf(stderr, "drift adj error = %b64d usec\n", + ERTS_MONOTONIC_TO_USEC(time_sup.r.o.drift_adj.error)); + erts_fprintf(stderr, "drift adj max diff = %b64d nsec\n", + ERTS_MONOTONIC_TO_NSEC(ERTS_TIME_DRIFT_MAX_ADJ_DIFF)); + erts_fprintf(stderr, "drift adj min diff = %b64d nsec\n", + ERTS_MONOTONIC_TO_NSEC(ERTS_TIME_DRIFT_MIN_ADJ_DIFF)); + } #endif if (ERTS_MONOTONIC_TIME_UNIT < ERTS_CLKTCK_RESOLUTION) @@ -967,8 +1112,9 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) erts_os_times(&time_sup.inf.c.minit, &time_sup.inf.c.sinit); time_sup.r.o.moffset = -1*time_sup.inf.c.minit; + time_sup.r.o.moffset += ERTS_MONOTONIC_BEGIN; offset = time_sup.inf.c.sinit; - offset -= ERTS_MONOTONIC_TIME_UNIT; + offset -= ERTS_MONOTONIC_BEGIN; init_time_offset(offset); rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; @@ -979,19 +1125,22 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) cdatap = &time_sup.inf.c.parmon.cdata; -#ifndef ERTS_HAVE_CORRECTED_OS_MONOTONIC cdatap->drift.intervals[0].time.sys = time_sup.inf.c.sinit; cdatap->drift.intervals[0].time.mon = time_sup.inf.c.minit; cdatap->curr.correction.drift = 0; -#endif cdatap->curr.correction.error = 0; - cdatap->curr.erl_mtime = ERTS_MONOTONIC_TIME_UNIT; + cdatap->curr.erl_mtime = ERTS_MONOTONIC_BEGIN; cdatap->curr.os_mtime = time_sup.inf.c.minit; cdatap->last_check = time_sup.inf.c.minit; cdatap->short_check_interval = ERTS_INIT_SHORT_INTERVAL_COUNTER; cdatap->prev = cdatap->curr; - time_sup.r.o.get_time = get_corrected_time; + if (!time_sup.r.o.os_corrected_monotonic_time) + time_sup.r.o.get_time = get_corrected_time; + else if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE) + time_sup.r.o.get_time = get_os_corrected_time; + else + time_sup.r.o.get_time = get_os_drift_corrected_time; } else #endif @@ -999,7 +1148,7 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) ErtsMonotonicTime stime, offset; time_sup.r.o.get_time = get_not_corrected_time; stime = time_sup.inf.c.sinit = erts_os_system_time(); - offset = stime - ERTS_MONOTONIC_TIME_UNIT; + offset = stime - ERTS_MONOTONIC_BEGIN; time_sup.inf.c.not_corrected_moffset = offset; init_time_offset(offset); time_sup.f.c.last_not_corrected_time = 0; @@ -1019,14 +1168,24 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) void erts_late_init_time_sup(void) { -#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT - /* Timer wheel must be initialized */ - if (time_sup.r.o.get_time == get_corrected_time) - late_init_time_correction(); -#endif erts_late_sys_init_time(); } +void +erts_sched_init_time_sup(ErtsSchedulerData *esdp) +{ + esdp->timer_wheel = erts_create_timer_wheel(esdp); + esdp->next_tmo_ref = erts_get_next_timeout_reference(esdp->timer_wheel); + esdp->timer_service = erts_create_timer_service(); +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + if (esdp->no == 1) { + /* A timer wheel to use must have beeen initialized */ + if (time_sup.r.o.get_time != get_not_corrected_time) + late_init_time_correction(esdp); + } +#endif +} + ErtsTimeWarpMode erts_time_warp_mode(void) { return time_sup.r.o.warp_mode; @@ -1038,9 +1197,9 @@ ErtsTimeOffsetState erts_time_offset_state(void) case ERTS_NO_TIME_WARP_MODE: return ERTS_TIME_OFFSET_FINAL; case ERTS_SINGLE_TIME_WARP_MODE: - if (time_sup.inf.c.finalized_offset) - return ERTS_TIME_OFFSET_FINAL; - return ERTS_TIME_OFFSET_PRELIMINARY; + if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) + return ERTS_TIME_OFFSET_PRELIMINARY; + return ERTS_TIME_OFFSET_FINAL; case ERTS_MULTI_TIME_WARP_MODE: return ERTS_TIME_OFFSET_VOLATILE; default: @@ -1073,7 +1232,7 @@ erts_finalize_time_offset(void) erts_smp_mtx_lock(&erts_get_time_mtx); - if (!time_sup.inf.c.finalized_offset) { + if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) { ErtsMonotonicTime mtime, new_offset; #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT @@ -1110,19 +1269,12 @@ erts_finalize_time_offset(void) set_time_offset(new_offset); schedule_send_time_offset_changed_notifications(new_offset); - time_sup.inf.c.finalized_offset = ~0; + erts_smp_atomic32_set_nob(&time_sup.inf.c.preliminary_offset, 0); res = ERTS_TIME_OFFSET_PRELIMINARY; } erts_smp_mtx_unlock(&erts_get_time_mtx); -#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT - if (res == ERTS_TIME_OFFSET_PRELIMINARY - && time_sup.r.o.get_time == get_corrected_time) { - late_init_time_correction(); - } -#endif - return res; } default: @@ -1176,6 +1328,7 @@ wall_clock_elapsed_time_both(UWord *ms_total, UWord *ms_diff) erts_smp_mtx_lock(&erts_timeofday_mtx); now = time_sup.r.o.get_time(); + update_last_mtime(NULL, now); elapsed = ERTS_MONOTONIC_TO_MSEC(now); *ms_total = (UWord) elapsed; @@ -1564,6 +1717,7 @@ get_now(Uint* megasec, Uint* sec, Uint* microsec) mtime = time_sup.r.o.get_time(); time_offset = get_time_offset(); + update_last_mtime(NULL, mtime); now = ERTS_MONOTONIC_TO_USEC(mtime + time_offset); erts_smp_mtx_lock(&erts_timeofday_mtx); @@ -1588,9 +1742,11 @@ get_now(Uint* megasec, Uint* sec, Uint* microsec) } ErtsMonotonicTime -erts_get_monotonic_time(void) +erts_get_monotonic_time(ErtsSchedulerData *esdp) { - return time_sup.r.o.get_time(); + ErtsMonotonicTime mtime = time_sup.r.o.get_time(); + update_last_mtime(esdp, mtime); + return mtime; } void @@ -1817,7 +1973,13 @@ make_time_val(Process *c_p, ErtsMonotonicTime time_val) Eterm erts_get_monotonic_start_time(struct process *c_p) { - return make_time_val(c_p, ERTS_MONOTONIC_TIME_START); + return make_time_val(c_p, ERTS_MONOTONIC_TIME_START_EXTERNAL); +} + +Eterm +erts_get_monotonic_end_time(struct process *c_p) +{ + return make_time_val(c_p, ERTS_MONOTONIC_TIME_END_EXTERNAL); } static Eterm @@ -2009,13 +2171,16 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto BIF_RETTYPE monotonic_time_0(BIF_ALIST_0) { ErtsMonotonicTime mtime = time_sup.r.o.get_time(); + update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); mtime += ERTS_MONOTONIC_OFFSET_NATIVE; BIF_RET(make_time_val(BIF_P, mtime)); } BIF_RETTYPE monotonic_time_1(BIF_ALIST_1) { - BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, time_sup.r.o.get_time(), 1)); + ErtsMonotonicTime mtime = time_sup.r.o.get_time(); + update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); + BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, mtime, 1)); } BIF_RETTYPE system_time_0(BIF_ALIST_0) @@ -2023,6 +2188,7 @@ BIF_RETTYPE system_time_0(BIF_ALIST_0) ErtsMonotonicTime mtime, offset; mtime = time_sup.r.o.get_time(); offset = get_time_offset(); + update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); BIF_RET(make_time_val(BIF_P, mtime + offset)); } @@ -2031,6 +2197,7 @@ BIF_RETTYPE system_time_1(BIF_ALIST_0) ErtsMonotonicTime mtime, offset; mtime = time_sup.r.o.get_time(); offset = get_time_offset(); + update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, mtime + offset, 0)); } @@ -2060,6 +2227,7 @@ BIF_RETTYPE timestamp_0(BIF_ALIST_0) 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); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 54fba9274f..340c7033ab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1309,8 +1309,7 @@ erts_alloc_message_heap_state(Uint size, state = erts_smp_atomic32_read_acqb(&receiver->state); if (statep) *statep = state; - if (state & (ERTS_PSFLG_OFF_HEAP_MSGS - | ERTS_PSFLG_EXITING + if (state & (ERTS_PSFLG_EXITING | ERTS_PSFLG_PENDING_EXIT)) goto allocate_in_mbuf; #endif @@ -1331,8 +1330,7 @@ erts_alloc_message_heap_state(Uint size, state = erts_smp_atomic32_read_nob(&receiver->state); if (statep) *statep = state; - if ((state & (ERTS_PSFLG_OFF_HEAP_MSGS - | ERTS_PSFLG_EXITING + if ((state & (ERTS_PSFLG_EXITING | ERTS_PSFLG_PENDING_EXIT)) || (receiver->flags & F_DISABLE_GC) || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) { diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index dec92be40a..ccc7da265e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -48,6 +48,7 @@ #include "dtrace-wrapper.h" #include "erl_map.h" #include "erl_bif_unique.h" +#include "erl_hl_timer.h" extern ErlDrvEntry fd_driver_entry; #ifndef __OSE__ @@ -379,11 +380,7 @@ static Port *create_port(char *name, prt->dist_entry = NULL; ERTS_PORT_INIT_CONNECTED(prt, pid); prt->common.u.alive.reg = NULL; -#ifdef ERTS_SMP - prt->common.u.alive.ptimer = NULL; -#else - sys_memset(&prt->common.u.alive.tm, 0, sizeof(ErlTimer)); -#endif + ERTS_PTMR_INIT(prt); erts_port_task_handle_init(&prt->timeout_task); prt->psd = NULL; prt->drv_data = (SWord) 0; @@ -463,11 +460,7 @@ erts_port_free(Port *prt) | ERTS_PORT_SFLG_FREE)); ASSERT(state & ERTS_PORT_SFLG_PORT_DEBUG); -#ifdef ERTS_SMP - ERTS_LC_ASSERT(erts_atomic32_read_nob(&prt->common.refc) == 0); -#else - ERTS_LC_ASSERT(erts_atomic32_read_nob(&prt->refc) == 0); -#endif + ERTS_LC_ASSERT(erts_atomic_read_nob(&prt->common.refc.atmc) == 0); erts_port_task_fini_sched(&prt->sched); @@ -736,11 +729,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ /* * Must clean up the port. */ -#ifdef ERTS_SMP - erts_cancel_smp_ptimer(port->common.u.alive.ptimer); -#else - erts_cancel_timer(&(port->common.u.alive.tm)); -#endif + erts_cancel_port_timer(port); stopq(port); if (port->linebuf != NULL) { erts_free(ERTS_ALC_T_LINEBUF, @@ -2798,7 +2787,8 @@ void erts_init_io(int port_tab_size, port_tab_size, common_element_size, /* Doesn't need to be excact */ "port_table", - legacy_port_tab); + legacy_port_tab, + 1); erts_smp_atomic_init_nob(&erts_bytes_out, 0); erts_smp_atomic_init_nob(&erts_bytes_in, 0); @@ -3065,7 +3055,7 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) rp = (scheduler ? erts_proc_lookup(pid) - : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC)); + : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC)); if (rp) { Eterm tuple; @@ -3083,7 +3073,7 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } } @@ -3127,7 +3117,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, rp = (scheduler ? erts_proc_lookup(to) - : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC)); + : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) return; @@ -3178,7 +3168,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } /* @@ -3264,7 +3254,7 @@ deliver_vec_message(Port* prt, /* Port */ rp = (scheduler ? erts_proc_lookup(to) - : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC)); + : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) return; @@ -3344,7 +3334,7 @@ deliver_vec_message(Port* prt, /* Port */ erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } @@ -3434,11 +3424,8 @@ terminate_port(Port *prt) send_closed_port_id = NIL; } -#ifdef ERTS_SMP - erts_cancel_smp_ptimer(prt->common.u.alive.ptimer); -#else - erts_cancel_timer(&prt->common.u.alive.tm); -#endif + if (ERTS_PTMR_IS_SET(prt)) + erts_cancel_port_timer(prt); drv = prt->drv_ptr; if ((drv != NULL) && (drv->stop != NULL)) { @@ -4985,24 +4972,6 @@ erts_free_port_names(ErtsPortNames *pnp) erts_free(ERTS_ALC_T_PORT_NAMES, pnp); } -static void schedule_port_timeout(Port *p) -{ - /* - * Scheduling of port timeouts can be done without port locking, but - * since the task handle is stored in the port structure and the ptimer - * structure is protected by the port lock we require the port to be - * locked for now... - * - * TODO: Implement scheduling of port timeouts without locking - * the port. - * /Rickard - */ - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); - erts_port_task_schedule(p->common.id, - &p->timeout_task, - ERTS_PORT_TASK_TIMEOUT); -} - ErlDrvTermData driver_mk_term_nil(void) { return driver_term_nil; @@ -5031,7 +5000,7 @@ void driver_report_exit(ErlDrvPort ix, int status) rp = (scheduler ? erts_proc_lookup(pid) - : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC)); + : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) return; @@ -5045,7 +5014,7 @@ void driver_report_exit(ErlDrvPort ix, int status) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } #define ERTS_B2T_STATES_DEF_STATES_SZ 5 @@ -5361,7 +5330,7 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) scheduler = erts_get_scheduler_id() != 0; rp = (scheduler ? erts_proc_lookup(to) - : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC)); + : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) { res = 0; goto done; @@ -5656,14 +5625,12 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) HRelease(rp, hp_end, hp); } } -#ifdef ERTS_SMP if (rp) { if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } -#endif cleanup_b2t_states(&b2t); DESTROY_ESTACK(stack); return res; @@ -6609,18 +6576,6 @@ int driver_pushq(ErlDrvPort ix, char* buffer, ErlDrvSizeT len) return code; } -static ERTS_INLINE void -drv_cancel_timer(Port *prt) -{ -#ifdef ERTS_SMP - erts_cancel_smp_ptimer(prt->common.u.alive.ptimer); -#else - erts_cancel_timer(&prt->common.u.alive.tm); -#endif - if (erts_port_task_is_scheduled(&prt->timeout_task)) - erts_port_task_abort(&prt->timeout_task); -} - int driver_set_timer(ErlDrvPort ix, unsigned long t) { Port* prt = erts_drvport2port(ix); @@ -6632,19 +6587,8 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t) if (prt->drv_ptr->timeout == NULL) return -1; - drv_cancel_timer(prt); -#ifdef ERTS_SMP - erts_create_smp_ptimer(&prt->common.u.alive.ptimer, - prt->common.id, - (ErlTimeoutProc) schedule_port_timeout, - t); -#else - erts_set_timer(&prt->common.u.alive.tm, - (ErlTimeoutProc) schedule_port_timeout, - NULL, - prt, - t); -#endif + + erts_set_port_timer(prt, (Sint64) t); return 0; } @@ -6654,28 +6598,28 @@ int driver_cancel_timer(ErlDrvPort ix) if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - drv_cancel_timer(prt); + erts_cancel_port_timer(prt); return 0; } - int driver_read_timer(ErlDrvPort ix, unsigned long* t) { Port* prt = erts_drvport2port(ix); + Sint64 left; ERTS_SMP_CHK_NO_PROC_LOCKS; if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); -#ifdef ERTS_SMP - *t = (prt->common.u.alive.ptimer - ? erts_time_left(&prt->common.u.alive.ptimer->timer.tm) - : 0); -#else - *t = erts_time_left(&prt->common.u.alive.tm); -#endif + + left = erts_read_port_timer(prt); + if (left < 0) + left = 0; + + *t = (unsigned long) left; + return 0; } diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c index c626cb2780..4d557b3a17 100644 --- a/erts/emulator/beam/register.c +++ b/erts/emulator/beam/register.c @@ -269,7 +269,10 @@ erts_whereis_name_to_id(Process *c_p, Eterm name) #ifdef ERTS_SMP ErtsProcLocks c_p_locks = c_p ? ERTS_PROC_LOCK_MAIN : 0; - ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); +#ifdef ERTS_ENABLE_LOCK_CHECK + if (c_p) ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); +#endif + reg_safe_read_lock(c_p, &c_p_locks); if (c_p && !c_p_locks) erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); @@ -380,8 +383,6 @@ erts_whereis_name(Process *c_p, erts_smp_proc_unlock(rp->p, need_locks); *proc = NULL; } - if (*proc && (flags & ERTS_P2P_FLG_SMP_INC_REFC)) - erts_smp_proc_inc_refc(rp->p); } #else if (rp->p @@ -390,6 +391,8 @@ erts_whereis_name(Process *c_p, else *proc = NULL; #endif + if (*proc && (flags & ERTS_P2P_FLG_INC_REFC)) + erts_proc_inc_refc(*proc); } } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 251b39508f..cd53069872 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -657,6 +657,7 @@ erts_dsprintf_buf_t *erts_create_logger_dsbuf(void); int erts_send_info_to_logger(Eterm, erts_dsprintf_buf_t *); int erts_send_warning_to_logger(Eterm, erts_dsprintf_buf_t *); int erts_send_error_to_logger(Eterm, erts_dsprintf_buf_t *); +int erts_send_error_term_to_logger(Eterm, erts_dsprintf_buf_t *, Eterm); int erts_send_info_to_logger_str(Eterm, char *); int erts_send_warning_to_logger_str(Eterm, char *); int erts_send_error_to_logger_str(Eterm, char *); @@ -703,14 +704,9 @@ extern char *erts_default_arg0; extern char os_type[]; -typedef enum { - ERTS_NO_TIME_WARP_MODE, - ERTS_SINGLE_TIME_WARP_MODE, - ERTS_MULTI_TIME_WARP_MODE -} ErtsTimeWarpMode; - typedef struct { int have_os_monotonic_time; + int have_corrected_os_monotonic_time; ErtsMonotonicTime os_monotonic_time_unit; ErtsMonotonicTime sys_clock_resolution; struct { @@ -729,14 +725,13 @@ typedef struct { } ErtsSysInitTimeResult; #define ERTS_SYS_INIT_TIME_RESULT_INITER \ - {0, (ErtsMonotonicTime) -1, (ErtsMonotonicTime) 1} + {0, 0, (ErtsMonotonicTime) -1, (ErtsMonotonicTime) 1} extern void erts_init_sys_time_sup(void); extern void sys_init_time(ErtsSysInitTimeResult *); extern void erts_late_sys_init_time(void); extern void erts_deliver_time(void); extern void erts_time_remaining(SysTimeval *); -extern int erts_init_time_sup(int, ErtsTimeWarpMode); extern void erts_sys_init_float(void); extern void erts_thread_init_float(void); extern void erts_thread_disable_fpe(void); @@ -782,8 +777,6 @@ extern char *erts_sys_ddll_error(int code); /* * System interfaces for startup. */ -#include "erl_time.h" - void erts_sys_schedule_interrupt(int set); #ifdef ERTS_SMP void erts_sys_schedule_interrupt_timed(int, ErtsMonotonicTime); @@ -825,7 +818,8 @@ int univ_to_local( int local_to_univ(Sint *year, Sint *month, Sint *day, Sint *hour, Sint *minute, Sint *second, int isdst); void get_now(Uint*, Uint*, Uint*); -ErtsMonotonicTime erts_get_monotonic_time(void); +struct ErtsSchedulerData_; +ErtsMonotonicTime erts_get_monotonic_time(struct ErtsSchedulerData_ *); 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 2bdda6c8af..8bffdedb2b 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -76,6 +76,11 @@ #include "sys.h" #include "erl_vm.h" #include "global.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" + +#define ERTS_MONOTONIC_DAY ERTS_SEC_TO_MONOTONIC(60*60*24) +#define ERTS_CLKTCKS_DAY ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY) #ifdef ERTS_ENABLE_LOCK_CHECK #define ASSERT_NO_LOCKED_LOCKS erts_lc_check_exact(NULL, 0) @@ -83,20 +88,24 @@ #define ASSERT_NO_LOCKED_LOCKS #endif -#define ERTS_MONOTONIC_DAY ERTS_SEC_TO_MONOTONIC(60*60*24) -#define ERTS_CLKTCKS_DAY ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY) - +#if 0 +# define ERTS_TW_DEBUG +#endif +#if defined(DEBUG) && !defined(ERTS_TW_DEBUG) +# define ERTS_TW_DEBUG +#endif -/* BEGIN tiw_lock protected variables -** -** The individual timer cells in tiw are also protected by the same mutex. -*/ +#undef ERTS_TW_ASSERT +#if defined(ERTS_TW_DEBUG) +# define ERTS_TW_ASSERT(E) ERTS_ASSERT(E) +#else +# define ERTS_TW_ASSERT(E) ((void) 1) +#endif -/* timing wheel size NEED to be a power of 2 */ -#ifdef SMALL_MEMORY -#define TIW_SIZE (1 << 13) +#ifdef ERTS_TW_DEBUG +# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 5 #else -#define TIW_SIZE (1 << 20) +# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 100 #endif /* Actual interval time chosen by sys_init_time() */ @@ -110,173 +119,170 @@ static int tiw_itime; /* Constant after init */ #endif struct ErtsTimerWheel_ { - ErlTimer *w[TIW_SIZE]; + ErtsTWheelTimer *w[ERTS_TIW_SIZE]; ErtsMonotonicTime pos; Uint nto; struct { - ErlTimer *head; - ErlTimer **tail; + ErtsTWheelTimer *head; + ErtsTWheelTimer *tail; Uint nto; } at_once; + int yield_slot; + int yield_slots_left; + int yield_start_pos; + ErtsTWheelTimer sentinel; int true_next_timeout_time; ErtsMonotonicTime next_timeout_time; - erts_atomic64_t next_timeout; - erts_smp_atomic32_t is_bumping; - erts_smp_mtx_t lock; }; -ErtsTimerWheel *erts_default_timer_wheel; /* managed by aux thread */ - -static ERTS_INLINE ErtsTimerWheel * -get_timer_wheel(ErlTimer *p) -{ - return (ErtsTimerWheel *) erts_smp_atomic_read_acqb(&p->wheel); -} - -static ERTS_INLINE void -set_timer_wheel(ErlTimer *p, ErtsTimerWheel *tiw) -{ - erts_smp_atomic_set_relb(&p->wheel, (erts_aint_t) tiw); -} - -static ERTS_INLINE void -init_next_timeout(ErtsTimerWheel *tiw, - ErtsMonotonicTime time) -{ - erts_atomic64_init_nob(&tiw->next_timeout, - (erts_aint64_t) time); -} - -static ERTS_INLINE void -set_next_timeout(ErtsTimerWheel *tiw, - ErtsMonotonicTime time, - int true_timeout) -{ - tiw->true_next_timeout_time = true_timeout; - tiw->next_timeout_time = time; - erts_atomic64_set_relb(&tiw->next_timeout, - (erts_aint64_t) time); -} - -/* get the time (in units of TIW_ITIME) to the next timeout, - or -1 if there are no timeouts */ - static ERTS_INLINE ErtsMonotonicTime -find_next_timeout(ErtsTimerWheel *tiw, - ErtsMonotonicTime curr_time, - ErtsMonotonicTime max_search_time) +find_next_timeout(ErtsSchedulerData *esdp, + ErtsTimerWheel *tiw, + int search_all, + ErtsMonotonicTime curr_time, /* When !search_all */ + ErtsMonotonicTime max_search_time) /* When !search_all */ { int start_ix, tiw_pos_ix; - ErlTimer *p; - int true_min_timeout; - ErtsMonotonicTime min_timeout, min_timeout_pos, slot_timeout_pos, timeout_limit; - - ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&tiw->lock)); - - if (tiw->true_next_timeout_time) - return tiw->next_timeout_time; - - /* We never set next timeout beyond timeout_limit */ - timeout_limit = curr_time + ERTS_MONOTONIC_DAY; + ErtsTWheelTimer *p; + int true_min_timeout = 0; + ErtsMonotonicTime min_timeout, min_timeout_pos, slot_timeout_pos; if (tiw->nto == 0) { /* no timeouts in wheel */ - true_min_timeout = tiw->true_next_timeout_time = 0; - min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(timeout_limit); + if (!search_all) + min_timeout_pos = tiw->pos; + else { + curr_time = erts_get_monotonic_time(esdp); + tiw->pos = min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); + } + min_timeout_pos += ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY); goto found_next; } - /* - * Don't want others entering trying to bump - * timers while we are checking... - */ - set_next_timeout(tiw, timeout_limit, 0); - - true_min_timeout = 1; - slot_timeout_pos = tiw->pos; - min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time + max_search_time); + slot_timeout_pos = min_timeout_pos = tiw->pos; + if (search_all) + min_timeout_pos += ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY); + else + min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time + max_search_time); - start_ix = tiw_pos_ix = (int) (tiw->pos & (TIW_SIZE-1)); + start_ix = tiw_pos_ix = (int) (tiw->pos & (ERTS_TIW_SIZE-1)); do { - slot_timeout_pos++; - if (slot_timeout_pos >= min_timeout_pos) { - true_min_timeout = 0; + if (++slot_timeout_pos >= min_timeout_pos) break; - } p = tiw->w[tiw_pos_ix]; - while (p) { - ErtsMonotonicTime timeout_pos; - ASSERT(p != p->next); - timeout_pos = p->timeout_pos; - if (min_timeout_pos > timeout_pos) { - min_timeout_pos = timeout_pos; - if (min_timeout_pos <= slot_timeout_pos) - goto found_next; - } - p = p->next; + if (p) { + ErtsTWheelTimer *end = p; + + do { + ErtsMonotonicTime timeout_pos; + timeout_pos = p->timeout_pos; + if (min_timeout_pos > timeout_pos) { + true_min_timeout = 1; + min_timeout_pos = timeout_pos; + if (min_timeout_pos <= slot_timeout_pos) + goto found_next; + } + p = p->next; + } while (p != end); } tiw_pos_ix++; - if (tiw_pos_ix == TIW_SIZE) + if (tiw_pos_ix == ERTS_TIW_SIZE) tiw_pos_ix = 0; } while (start_ix != tiw_pos_ix); found_next: min_timeout = ERTS_CLKTCKS_TO_MONOTONIC(min_timeout_pos); - if (min_timeout != tiw->next_timeout_time) - set_next_timeout(tiw, min_timeout, true_min_timeout); + tiw->next_timeout_time = min_timeout; + tiw->true_next_timeout_time = true_min_timeout; return min_timeout; } -static void -remove_timer(ErtsTimerWheel *tiw, ErlTimer *p) +static ERTS_INLINE void +insert_timer_into_slot(ErtsTimerWheel *tiw, int slot, ErtsTWheelTimer *p) { - /* first */ - if (!p->prev) { - tiw->w[p->slot] = p->next; - if(p->next) - p->next->prev = NULL; - } else { - p->prev->next = p->next; + ERTS_TW_ASSERT(slot >= 0); + ERTS_TW_ASSERT(slot < ERTS_TIW_SIZE); + p->slot = slot; + if (!tiw->w[slot]) { + tiw->w[slot] = p; + p->next = p; + p->prev = p; } + else { + ErtsTWheelTimer *next, *prev; + next = tiw->w[slot]; + prev = next->prev; + p->next = next; + p->prev = prev; + prev->next = p; + next->prev = p; + } +} + +static ERTS_INLINE void +remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) +{ + int slot = p->slot; + ERTS_TW_ASSERT(slot != ERTS_TWHEEL_SLOT_INACTIVE); + + if (slot >= 0) { + /* + * Timer in wheel or in circular + * list of timers currently beeing + * triggered (referred by sentinel). + */ + ERTS_TW_ASSERT(slot < ERTS_TIW_SIZE); - /* last */ - if (!p->next) { + if (p->next == p) { + ERTS_TW_ASSERT(tiw->w[slot] == p); + tiw->w[slot] = NULL; + } + else { + if (tiw->w[slot] == p) + tiw->w[slot] = p->next; + p->prev->next = p->next; + p->next->prev = p->prev; + } + } + else { + /* Timer in "at once" queue... */ + ERTS_TW_ASSERT(slot == ERTS_TWHEEL_SLOT_AT_ONCE); if (p->prev) - p->prev->next = NULL; - } else { - p->next->prev = p->prev; + p->prev->next = p->next; + else { + ERTS_TW_ASSERT(tiw->at_once.head == p); + tiw->at_once.head = p->next; + } + if (p->next) + p->next->prev = p->prev; + else { + ERTS_TW_ASSERT(tiw->at_once.tail == p); + tiw->at_once.tail = p->prev; + } + ERTS_TW_ASSERT(tiw->at_once.nto > 0); + tiw->at_once.nto--; } - p->next = NULL; - p->prev = NULL; + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; - set_timer_wheel(p, NULL); tiw->nto--; } ErtsMonotonicTime -erts_check_next_timeout_time(ErtsTimerWheel *tiw, - ErtsMonotonicTime max_search_time) +erts_check_next_timeout_time(ErtsSchedulerData *esdp) { - ErtsMonotonicTime next, curr; - - curr = erts_get_monotonic_time(); - - erts_smp_mtx_lock(&tiw->lock); - - next = find_next_timeout(tiw, curr, max_search_time); - - erts_smp_mtx_unlock(&tiw->lock); - - return next; + ErtsTimerWheel *tiw = esdp->timer_wheel; + if (tiw->true_next_timeout_time) + return tiw->next_timeout_time; + return find_next_timeout(esdp, tiw, 1, 0, 0); } -#ifndef DEBUG +#ifndef ERTS_TW_DEBUG #define ERTS_DBG_CHK_SAFE_TO_SKIP_TO(TIW, TO) ((void) 0) #else #define ERTS_DBG_CHK_SAFE_TO_SKIP_TO(TIW, TO) debug_check_safe_to_skip_to((TIW), (TO)) @@ -284,192 +290,252 @@ static void debug_check_safe_to_skip_to(ErtsTimerWheel *tiw, ErtsMonotonicTime skip_to_pos) { int slots, ix; - ErlTimer *tmr; + ErtsTWheelTimer *tmr; ErtsMonotonicTime tmp; - ix = (int) (tiw->pos & (TIW_SIZE-1)); + ix = (int) (tiw->pos & (ERTS_TIW_SIZE-1)); tmp = skip_to_pos - tiw->pos; - ASSERT(tmp >= 0); - if (tmp < (ErtsMonotonicTime) TIW_SIZE) + ERTS_TW_ASSERT(tmp >= 0); + if (tmp < (ErtsMonotonicTime) ERTS_TIW_SIZE) slots = (int) tmp; else - slots = TIW_SIZE; + slots = ERTS_TIW_SIZE; while (slots > 0) { - tmr = tiw->w[ix]; - while (tmr) { - ASSERT(tmr->timeout_pos > skip_to_pos); - tmr = tmr->next; - } - ix++; - if (ix == TIW_SIZE) - ix = 0; - slots--; + tmr = tiw->w[ix]; + if (tmr) { + ErtsTWheelTimer *end = tmr; + do { + ERTS_TW_ASSERT(tmr->timeout_pos > skip_to_pos); + tmr = tmr->next; + } while (tmr != end); + } + ix++; + if (ix == ERTS_TIW_SIZE) + ix = 0; + slots--; } } #endif +static ERTS_INLINE void +timeout_timer(ErtsTWheelTimer *p) +{ + ErlTimeoutProc timeout; + void *arg; + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; + timeout = p->u.func.timeout; + arg = p->u.func.arg; + (*timeout)(arg); + ASSERT_NO_LOCKED_LOCKS; +} + void erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { - int tiw_pos_ix, slots; - ErlTimer *p, *timeout_head, **timeout_tail; - ErtsMonotonicTime bump_to, tmp_slots; - - if (erts_smp_atomic32_cmpxchg_nob(&tiw->is_bumping, 1, 0) != 0) - return; /* Another thread is currently bumping... */ + int tiw_pos_ix, slots, yielded_slot_restarted, yield_count; + ErtsMonotonicTime bump_to, tmp_slots, old_pos; - bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); + yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; - erts_smp_mtx_lock(&tiw->lock); + /* + * In order to be fair we always continue with work + * where we left off when restarting after a yield. + */ - if (tiw->pos >= bump_to) { - timeout_head = NULL; - goto done; + if (tiw->yield_slot >= 0) { + yielded_slot_restarted = 1; + tiw_pos_ix = tiw->yield_slot; + slots = tiw->yield_slots_left; + bump_to = tiw->pos; + old_pos = tiw->yield_start_pos; + goto restart_yielded_slot; } - /* Don't want others here while we are bumping... */ - set_next_timeout(tiw, curr_time + ERTS_MONOTONIC_DAY, 0); + do { - if (!tiw->at_once.head) { - timeout_head = NULL; - timeout_tail = &timeout_head; - } - else { - ASSERT(tiw->nto >= tiw->at_once.nto); - timeout_head = tiw->at_once.head; - timeout_tail = tiw->at_once.tail; - tiw->nto -= tiw->at_once.nto; - tiw->at_once.head = NULL; - tiw->at_once.tail = &tiw->at_once.head; - tiw->at_once.nto = 0; - } + yielded_slot_restarted = 0; - if (tiw->nto == 0) { - ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, bump_to); - tiw->pos = bump_to; - goto done; - } + bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); - if (tiw->true_next_timeout_time) { - ErtsMonotonicTime skip_until_pos; - /* - * No need inspecting slots where we know no timeouts - * to trigger should reside. - */ + while (1) { + ErtsTWheelTimer *p; - skip_until_pos = ERTS_MONOTONIC_TO_CLKTCKS(tiw->next_timeout_time); - if (skip_until_pos > bump_to) - skip_until_pos = bump_to; + old_pos = tiw->pos; - ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, skip_until_pos); - ASSERT(skip_until_pos > tiw->pos); - - tiw->pos = skip_until_pos - 1; - } + if (tiw->nto == 0) { + empty_wheel: + ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, bump_to); + tiw->true_next_timeout_time = 0; + tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; + tiw->pos = bump_to; + tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + return; + } - tiw_pos_ix = (int) ((tiw->pos+1) & (TIW_SIZE-1)); - tmp_slots = (bump_to - tiw->pos); - if (tmp_slots < (ErtsMonotonicTime) TIW_SIZE) - slots = (int) tmp_slots; - else - slots = TIW_SIZE; - - while (slots > 0) { - p = tiw->w[tiw_pos_ix]; - while (p) { - ErlTimer *next = p->next; - ASSERT(p != next); - if (p->timeout_pos <= bump_to) { /* we have a timeout */ - /* Remove from list */ - remove_timer(tiw, p); - *timeout_tail = p; /* Insert in timeout queue */ - timeout_tail = &p->next; + p = tiw->at_once.head; + while (p) { + if (--yield_count <= 0) { + ERTS_TW_ASSERT(tiw->nto > 0); + ERTS_TW_ASSERT(tiw->at_once.nto > 0); + tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE; + tiw->true_next_timeout_time = 1; + tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos); + return; + } + + ERTS_TW_ASSERT(tiw->nto > 0); + ERTS_TW_ASSERT(tiw->at_once.nto > 0); + tiw->nto--; + tiw->at_once.nto--; + tiw->at_once.head = p->next; + if (p->next) + p->next->prev = NULL; + else + tiw->at_once.tail = NULL; + + timeout_timer(p); + + p = tiw->at_once.head; } - p = next; - } - tiw_pos_ix++; - if (tiw_pos_ix == TIW_SIZE) - tiw_pos_ix = 0; - slots--; - } - ASSERT(tmp_slots >= (ErtsMonotonicTime) TIW_SIZE - || tiw_pos_ix == (int) ((bump_to+1) & (TIW_SIZE-1))); + if (tiw->pos >= bump_to) + break; - tiw->pos = bump_to; + if (tiw->nto == 0) + goto empty_wheel; - /* Search at most two seconds ahead... */ - (void) find_next_timeout(tiw, curr_time, ERTS_SEC_TO_MONOTONIC(2)); + if (tiw->true_next_timeout_time) { + ErtsMonotonicTime skip_until_pos; + /* + * No need inspecting slots where we know no timeouts + * to trigger should reside. + */ -done: + skip_until_pos = ERTS_MONOTONIC_TO_CLKTCKS(tiw->next_timeout_time); + if (skip_until_pos > bump_to) + skip_until_pos = bump_to; - erts_smp_mtx_unlock(&tiw->lock); - - erts_smp_atomic32_set_nob(&tiw->is_bumping, 0); + skip_until_pos--; - /* Call timedout timers callbacks */ - while (timeout_head) { - ErlTimeoutProc timeout; - void *arg; - p = timeout_head; - timeout_head = p->next; - /* Here comes hairy use of the timer fields! - * They are reset without having the lock. - * It is assumed that no code but this will - * accesses any field until the ->timeout - * callback is called. - */ - ASSERT(p->timeout_pos <= bump_to); - p->next = NULL; - p->prev = NULL; - p->slot = 0; - timeout = p->timeout; - arg = p->arg; - (*timeout)(arg); - } + if (skip_until_pos > tiw->pos) { + ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, skip_until_pos); + + tiw->pos = skip_until_pos; + } + } + + tiw_pos_ix = (int) ((tiw->pos+1) & (ERTS_TIW_SIZE-1)); + tmp_slots = (bump_to - tiw->pos); + if (tmp_slots < (ErtsMonotonicTime) ERTS_TIW_SIZE) + slots = (int) tmp_slots; + else + slots = ERTS_TIW_SIZE; + + tiw->pos = bump_to; + + while (slots > 0) { + + p = tiw->w[tiw_pos_ix]; + if (p) { + if (p->next == p) { + ERTS_TW_ASSERT(tiw->sentinel.next == &tiw->sentinel); + ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel); + } + else { + tiw->sentinel.next = p->next; + tiw->sentinel.prev = p->prev; + tiw->sentinel.next->prev = &tiw->sentinel; + tiw->sentinel.prev->next = &tiw->sentinel; + } + tiw->w[tiw_pos_ix] = NULL; + + while (1) { + + if (p->timeout_pos > bump_to) { + /* Very unusual case... */ + ++yield_count; + insert_timer_into_slot(tiw, tiw_pos_ix, p); + } + else { + /* Normal case... */ + timeout_timer(p); + tiw->nto--; + } + + restart_yielded_slot: + + p = tiw->sentinel.next; + if (p == &tiw->sentinel) { + ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel); + break; + } + + if (--yield_count <= 0) { + tiw->true_next_timeout_time = 1; + tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos); + tiw->yield_slot = tiw_pos_ix; + tiw->yield_slots_left = slots; + tiw->yield_start_pos = old_pos; + return; /* Yield! */ + } + + tiw->sentinel.next = p->next; + p->next->prev = &tiw->sentinel; + } + } + tiw_pos_ix++; + if (tiw_pos_ix == ERTS_TIW_SIZE) + tiw_pos_ix = 0; + slots--; + } + } + + } while (yielded_slot_restarted); + + tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + tiw->true_next_timeout_time = 0; + tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; + + /* Search at most two seconds ahead... */ + (void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2)); } Uint erts_timer_wheel_memory_size(void) { -#ifdef ERTS_SMP - return sizeof(ErtsTimerWheel)*(1 + erts_no_schedulers); -#else - return sizeof(ErtsTimerWheel); -#endif + return sizeof(ErtsTimerWheel)*erts_no_schedulers; } ErtsTimerWheel * -erts_create_timer_wheel(int no) +erts_create_timer_wheel(ErtsSchedulerData *esdp) { ErtsMonotonicTime mtime; int i; ErtsTimerWheel *tiw; - tiw = (ErtsTimerWheel *) erts_alloc(ERTS_ALC_T_TIMER_WHEEL, - sizeof(ErtsTimerWheel)); - for(i = 0; i < TIW_SIZE; i++) + tiw = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_WHEEL, + sizeof(ErtsTimerWheel)); + for(i = 0; i < ERTS_TIW_SIZE; i++) tiw->w[i] = NULL; - erts_smp_atomic32_init_nob(&tiw->is_bumping, 0); - erts_smp_mtx_init_x(&tiw->lock, "timer_wheel", make_small(no)); - - mtime = erts_get_monotonic_time(); + mtime = erts_get_monotonic_time(esdp); tiw->pos = ERTS_MONOTONIC_TO_CLKTCKS(mtime); tiw->nto = 0; tiw->at_once.head = NULL; - tiw->at_once.tail = &tiw->at_once.head; + tiw->at_once.tail = NULL; tiw->at_once.nto = 0; + tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; tiw->true_next_timeout_time = 0; tiw->next_timeout_time = mtime + ERTS_MONOTONIC_DAY; - init_next_timeout(tiw, mtime + ERTS_MONOTONIC_DAY); + tiw->sentinel.next = &tiw->sentinel; + tiw->sentinel.prev = &tiw->sentinel; return tiw; } ErtsNextTimeoutRef erts_get_next_timeout_reference(ErtsTimerWheel *tiw) { - return (ErtsNextTimeoutRef) &tiw->next_timeout; + return (ErtsNextTimeoutRef) &tiw->next_timeout_time; } @@ -490,153 +556,83 @@ erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode) #else tiw_itime = itime; #endif - - erts_default_timer_wheel = erts_create_timer_wheel(0); } void -erts_set_timer(ErlTimer *p, ErlTimeoutProc timeout, - ErlCancelProc cancel, void *arg, Uint to) +erts_twheel_set_timer(ErtsTimerWheel *tiw, + ErtsTWheelTimer *p, ErlTimeoutProc timeout, + ErlCancelProc cancel, void *arg, + ErtsMonotonicTime timeout_pos) { - ErtsMonotonicTime timeout_time, timeout_pos; - ErtsMonotonicTime curr_time; - ErtsTimerWheel *tiw; - ErtsSchedulerData *esdp; + ErtsMonotonicTime timeout_time; - curr_time = erts_get_monotonic_time(); - esdp = erts_get_scheduler_data(); - if (esdp) - tiw = esdp->timer_wheel; - else - tiw = erts_default_timer_wheel; - - erts_smp_mtx_lock(&tiw->lock); - - if (get_timer_wheel(p)) - ERTS_INTERNAL_ERROR("Double set timer"); + p->u.func.timeout = timeout; + p->u.func.cancel = cancel; + p->u.func.arg = arg; - p->timeout = timeout; - p->cancel = cancel; - p->arg = arg; + ERTS_TW_ASSERT(p->slot == ERTS_TWHEEL_SLOT_INACTIVE); - if (to == 0) { - timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); + if (timeout_pos <= tiw->pos) { tiw->nto++; tiw->at_once.nto++; - *tiw->at_once.tail = p; - tiw->at_once.tail = &p->next; p->next = NULL; - p->timeout_pos = timeout_pos; - timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(timeout_pos); + p->prev = tiw->at_once.tail; + if (tiw->at_once.tail) { + ERTS_TW_ASSERT(tiw->at_once.head); + tiw->at_once.tail->next = p; + } + else { + ERTS_TW_ASSERT(!tiw->at_once.head); + tiw->at_once.head = p; + } + tiw->at_once.tail = p; + p->timeout_pos = tiw->pos; + p->slot = ERTS_TWHEEL_SLOT_AT_ONCE; + timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(tiw->pos); } else { - int tm; - ErtsMonotonicTime ticks; - - ticks = ERTS_MSEC_TO_CLKTCKS(to); - timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time - 1) + 1 + ticks; + int slot; /* calculate slot */ - tm = (int) (timeout_pos & (TIW_SIZE-1)); - p->slot = (Uint) tm; - - /* insert at head of list at slot */ - p->next = tiw->w[tm]; - p->prev = NULL; - if (p->next != NULL) - p->next->prev = p; - tiw->w[tm] = p; + slot = (int) (timeout_pos & (ERTS_TIW_SIZE-1)); + + insert_timer_into_slot(tiw, slot, p); tiw->nto++; timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(timeout_pos); p->timeout_pos = timeout_pos; - - ASSERT(ERTS_MSEC_TO_MONOTONIC(to) <= timeout_time - curr_time); - ASSERT(timeout_time - curr_time - < ERTS_MSEC_TO_MONOTONIC(to) + ERTS_CLKTCKS_TO_MONOTONIC(1)); } - if (timeout_time < tiw->next_timeout_time) - set_next_timeout(tiw, timeout_time, 1); - - set_timer_wheel(p, tiw); - - erts_smp_mtx_unlock(&tiw->lock); - -#if defined(ERTS_SMP) - if (tiw == erts_default_timer_wheel) - erts_interupt_aux_thread_timed(timeout_time); -#endif - + if (timeout_time < tiw->next_timeout_time) { + tiw->true_next_timeout_time = 1; + tiw->next_timeout_time = timeout_time; + } } void -erts_cancel_timer(ErlTimer *p) +erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) { - ErtsTimerWheel *tiw; - ErlCancelProc cancel; - void *arg = NULL; /* Shut up faulty warning... */ - - tiw = get_timer_wheel(p); - if (!tiw) - return; - - erts_smp_mtx_lock(&tiw->lock); - if (tiw != get_timer_wheel(p)) - cancel = NULL; - else { + if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) { + ErlCancelProc cancel; + void *arg; remove_timer(tiw, p); - p->slot = 0; - - cancel = p->cancel; - arg = p->arg; + cancel = p->u.func.cancel; + arg = p->u.func.arg; + if (cancel) + (*cancel)(arg); } - erts_smp_mtx_unlock(&tiw->lock); - - if (cancel) - (*cancel)(arg); } -/* - Returns the amount of time left in ms until the timer 'p' is triggered. - 0 is returned if 'p' isn't active. - 0 is returned also if the timer is overdue (i.e., would have triggered - immediately if it hadn't been cancelled). -*/ -Uint -erts_time_left(ErlTimer *p) -{ - ErtsTimerWheel *tiw; - ErtsMonotonicTime current_time, timeout_time; - - tiw = get_timer_wheel(p); - if (!tiw) - return 0; - - erts_smp_mtx_lock(&tiw->lock); - if (tiw != get_timer_wheel(p)) - timeout_time = ERTS_MONOTONIC_TIME_MIN; - else - timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(p->timeout_pos); - erts_smp_mtx_unlock(&tiw->lock); - - current_time = erts_get_monotonic_time(); - if (timeout_time <= current_time) - return 0; - return (Uint) ERTS_MONOTONIC_TO_MSEC(timeout_time - current_time); -} - -#ifdef DEBUG +#ifdef ERTS_TW_DEBUG void erts_p_slpq(void) { - ErtsTimerWheel *tiw = erts_default_timer_wheel; - ErtsMonotonicTime current_time = erts_get_monotonic_time(); + erts_printf("Not yet implemented...\n"); +#if 0 + ErtsMonotonicTime current_time = erts_get_monotonic_time(NULL); int i; - ErlTimer* p; + ErtsTWheelTimer* p; - erts_smp_mtx_lock(&tiw->lock); - /* print the whole wheel, starting at the current position */ erts_printf("\ncurrent time = %bps tiw_pos = %d tiw_nto %d\n", current_time, tiw->pos, tiw->nto); @@ -649,7 +645,7 @@ void erts_p_slpq(void) p->slot); } } - for(i = ((i+1) & (TIW_SIZE-1)); i != (tiw->pos & (TIW_SIZE-1)); i = ((i+1) & (TIW_SIZE-1))) { + for(i = ((i+1) & (ERTS_TIW_SIZE-1)); i != (tiw->pos & (ERTS_TIW_SIZE-1)); i = ((i+1) & (ERTS_TIW_SIZE-1))) { if (tiw->w[i] != NULL) { erts_printf("%d:\n", i); for(p = tiw->w[i]; p != NULL; p = p->next) { @@ -658,7 +654,6 @@ void erts_p_slpq(void) } } } - - erts_smp_mtx_unlock(&tiw->lock); +#endif } -#endif /* DEBUG */ +#endif /* ERTS_TW_DEBUG */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 51de3528be..965de748c9 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -50,6 +50,8 @@ #include "erl_ptab.h" #include "erl_check_io.h" #include "erl_bif_unique.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" #ifdef HIPE # include "hipe_mode_switch.h" #endif @@ -2220,97 +2222,157 @@ tail_recur: #undef MAKE_HASH_CDR_POST_OP } -static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +static Eterm +do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp, + ErlHeapFragment **bp, Process **p, Uint sz) { - /* error_logger ! - {notify,{info_msg,gleader,{emulator,"~s~n",[<message as list>]}}} | - {notify,{error,gleader,{emulator,"~s~n",[<message as list>]}}} | - {notify,{warning_msg,gleader,{emulator,"~s~n",[<message as list>}]}} */ - Eterm* hp; - Uint sz; Uint gl_sz; - Eterm gl; - Eterm list,plist,format,tuple1,tuple2,tuple3; - ErlOffHeap *ohp; - ErlHeapFragment *bp = NULL; -#if !defined(ERTS_SMP) - Process *p; -#endif - - ASSERT(is_atom(tag)); - - if (len <= 0) { - return -1; - } + gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader); + sz = sz + gl_sz; #ifndef ERTS_SMP #ifdef USE_THREADS - p = NULL; if (erts_get_scheduler_data()) /* Must be scheduler thread */ #endif { - p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0); - if (p) { - erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state); + *p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0); + if (*p) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&(*p)->state); if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)) - p = NULL; + *p = NULL; } } - if (!p) { - /* buf *always* points to a null terminated string */ - erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n", - tag, buf); - return 0; + if (!*p) { + return NIL; } - /* So we have an error logger, lets build the message */ -#endif - gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader); - sz = len * 2 /* message list */+ 2 /* cons surrounding message list */ - + gl_sz + - 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ + - 8 /* "~s~n" */; -#ifndef ERTS_SMP - if (sz <= HeapWordsLeft(p)) { - ohp = &MSO(p); - hp = HEAP_TOP(p); - HEAP_TOP(p) += sz; + /* So we have an error logger, lets build the message */ + if (sz <= HeapWordsLeft(*p)) { + *ohp = &MSO(*p); + *hp = HEAP_TOP(*p); + HEAP_TOP(*p) += sz; } else { #endif - bp = new_message_buffer(sz); - ohp = &bp->off_heap; - hp = bp->mem; + *bp = new_message_buffer(sz); + *ohp = &(*bp)->off_heap; + *hp = (*bp)->mem; #ifndef ERTS_SMP } #endif - gl = (is_nil(gleader) + + return (is_nil(gleader) ? am_noproc : (IS_CONST(gleader) ? gleader - : copy_struct(gleader,gl_sz,&hp,ohp))); - list = buf_to_intlist(&hp, buf, len, NIL); - plist = CONS(hp,list,NIL); - hp += 2; - format = buf_to_intlist(&hp, "~s~n", 4, NIL); - tuple1 = TUPLE3(hp, am_emulator, format, plist); - hp += 4; - tuple2 = TUPLE3(hp, tag, gl, tuple1); - hp += 4; - tuple3 = TUPLE2(hp, am_notify, tuple2); + : copy_struct(gleader,gl_sz,hp,*ohp))); +} + +static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *bp, + Process *p, Eterm message) +{ #ifdef HARDDEBUG - erts_fprintf(stderr, "%T\n", tuple3); + erts_fprintf(stderr, "%T\n", message); #endif #ifdef ERTS_SMP { Eterm from = erts_get_current_pid(); if (is_not_internal_pid(from)) from = NIL; - erts_queue_error_logger_message(from, tuple3, bp); + erts_queue_error_logger_message(from, message, bp); } #else - erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL); + erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL); #endif +} + +/* error_logger ! + {notify,{info_msg,gleader,{emulator,format,[args]}}} | + {notify,{error,gleader,{emulator,format,[args]}}} | + {notify,{warning_msg,gleader,{emulator,format,[args}]}} */ +static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +{ + Uint sz; + Eterm gl; + Eterm list,args,format,tuple1,tuple2,tuple3; + + Eterm *hp = NULL; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + Process *p = NULL; + + ASSERT(is_atom(tag)); + + if (len <= 0) { + return -1; + } + + sz = len * 2 /* message list */ + 2 /* cons surrounding message list */ + + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ + + 8 /* "~s~n" */; + + /* gleader size is accounted and allocated next */ + gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz); + + if(is_nil(gl)) { + /* buf *always* points to a null terminated string */ + erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n", + tag, buf); + return 0; + } + + list = buf_to_intlist(&hp, buf, len, NIL); + args = CONS(hp,list,NIL); + hp += 2; + format = buf_to_intlist(&hp, "~s~n", 4, NIL); + tuple1 = TUPLE3(hp, am_emulator, format, args); + hp += 4; + tuple2 = TUPLE3(hp, tag, gl, tuple1); + hp += 4; + tuple3 = TUPLE2(hp, am_notify, tuple2); + + do_send_logger_message(hp, ohp, bp, p, tuple3); + return 0; +} + +static int do_send_term_to_logger(Eterm tag, Eterm gleader, + char *buf, int len, Eterm args) +{ + Uint sz; + Eterm gl; + Uint args_sz; + Eterm format,tuple1,tuple2,tuple3; + + Eterm *hp = NULL; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + Process *p = NULL; + + ASSERT(is_atom(tag)); + + args_sz = size_object(args); + sz = len * 2 /* format */ + args_sz + + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */; + + /* gleader size is accounted and allocated next */ + gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz); + + if(is_nil(gl)) { + /* buf *always* points to a null terminated string */ + erts_fprintf(stderr, "(no error logger present) %T: \"%s\" %T\n", + tag, buf, args); + return 0; + } + + format = buf_to_intlist(&hp, buf, len, NIL); + args = copy_struct(args, args_sz, &hp, ohp); + tuple1 = TUPLE3(hp, am_emulator, format, args); + hp += 4; + tuple2 = TUPLE3(hp, tag, gl, tuple1); + hp += 4; + tuple3 = TUPLE2(hp, am_notify, tuple2); + + do_send_logger_message(hp, ohp, bp, p, tuple3); return 0; } @@ -2338,6 +2400,12 @@ send_error_to_logger(Eterm gleader, char *buf, int len) return do_send_to_logger(am_error, gleader, buf, len); } +static ERTS_INLINE int +send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args) +{ + return do_send_term_to_logger(am_error, gleader, buf, len, args); +} + #define LOGGER_DSBUF_INC_SZ 256 static erts_dsprintf_buf_t * @@ -2413,6 +2481,15 @@ erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp) } int +erts_send_error_term_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp, Eterm args) +{ + int res; + res = send_error_term_to_logger(gleader, dsbufp->str, dsbufp->str_len, args); + destroy_logger_dsbuf(dsbufp); + return res; +} + +int erts_send_info_to_logger_str(Eterm gleader, char *str) { return send_info_to_logger(gleader, str, sys_strlen(str)); @@ -4441,145 +4518,6 @@ is_string(Eterm list) return 0; } -#ifdef ERTS_SMP - -/* - * Process and Port timers in smp case - */ - -ERTS_SCHED_PREF_PRE_ALLOC_IMPL(ptimer_pre, ErtsSmpPTimer, 1000) - -#define ERTS_PTMR_FLGS_ALLCD_SIZE \ - 2 -#define ERTS_PTMR_FLGS_ALLCD_MASK \ - ((((Uint32) 1) << ERTS_PTMR_FLGS_ALLCD_SIZE) - 1) - -#define ERTS_PTMR_FLGS_PREALLCD ((Uint32) 1) -#define ERTS_PTMR_FLGS_SLALLCD ((Uint32) 2) -#define ERTS_PTMR_FLGS_LLALLCD ((Uint32) 3) -#define ERTS_PTMR_FLG_CANCELLED (((Uint32) 1) << (ERTS_PTMR_FLGS_ALLCD_SIZE+0)) - -static void -init_ptimers(void) -{ - init_ptimer_pre_alloc(); -} - -static ERTS_INLINE void -free_ptimer(ErtsSmpPTimer *ptimer) -{ - switch (ptimer->timer.flags & ERTS_PTMR_FLGS_ALLCD_MASK) { - case ERTS_PTMR_FLGS_PREALLCD: - (void) ptimer_pre_free(ptimer); - break; - case ERTS_PTMR_FLGS_SLALLCD: - erts_free(ERTS_ALC_T_SL_PTIMER, (void *) ptimer); - break; - case ERTS_PTMR_FLGS_LLALLCD: - erts_free(ERTS_ALC_T_LL_PTIMER, (void *) ptimer); - break; - default: - erl_exit(ERTS_ABORT_EXIT, - "Internal error: Bad ptimer alloc type\n"); - break; - } -} - -/* Callback for process timeout cancelled */ -static void -ptimer_cancelled(ErtsSmpPTimer *ptimer) -{ - free_ptimer(ptimer); -} - -/* Callback for process timeout */ -static void -ptimer_timeout(ErtsSmpPTimer *ptimer) -{ - if (is_internal_pid(ptimer->timer.id)) { - Process *p; - p = erts_pid2proc_opt(NULL, - 0, - ptimer->timer.id, - ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS, - ERTS_P2P_FLG_ALLOW_OTHER_X); - if (p) { - if (!ERTS_PROC_IS_EXITING(p) - && !(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) { - ASSERT(*ptimer->timer.timer_ref == ptimer); - *ptimer->timer.timer_ref = NULL; - (*ptimer->timer.timeout_func)(p); - } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); - } - } - else { - Port *p; - ASSERT(is_internal_port(ptimer->timer.id)); - p = erts_id2port_sflgs(ptimer->timer.id, - NULL, - 0, - ERTS_PORT_SFLGS_DEAD); - if (p) { - if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) { - ASSERT(*ptimer->timer.timer_ref == ptimer); - *ptimer->timer.timer_ref = NULL; - (*ptimer->timer.timeout_func)(p); - } - erts_port_release(p); - } - } - free_ptimer(ptimer); -} - -void -erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, - Eterm id, - ErlTimeoutProc timeout_func, - Uint timeout) -{ - ErtsSmpPTimer *res = ptimer_pre_alloc(); - if (res) - res->timer.flags = ERTS_PTMR_FLGS_PREALLCD; - else { - if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) { - res = erts_alloc(ERTS_ALC_T_SL_PTIMER, sizeof(ErtsSmpPTimer)); - res->timer.flags = ERTS_PTMR_FLGS_SLALLCD; - } - else { - res = erts_alloc(ERTS_ALC_T_LL_PTIMER, sizeof(ErtsSmpPTimer)); - res->timer.flags = ERTS_PTMR_FLGS_LLALLCD; - } - } - res->timer.timeout_func = timeout_func; - res->timer.timer_ref = timer_ref; - res->timer.id = id; - erts_init_timer(&res->timer.tm); - - ASSERT(!*timer_ref); - - *timer_ref = res; - - erts_set_timer(&res->timer.tm, - (ErlTimeoutProc) ptimer_timeout, - (ErlCancelProc) ptimer_cancelled, - (void*) res, - timeout); -} - -void -erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer) -{ - if (ptimer) { - ASSERT(*ptimer->timer.timer_ref == ptimer); - *ptimer->timer.timer_ref = NULL; - ptimer->timer.flags |= ERTS_PTMR_FLG_CANCELLED; - erts_cancel_timer(&ptimer->timer.tm); - } -} - -#endif - static int trim_threshold; static int top_pad; static int mmap_threshold; @@ -4589,9 +4527,7 @@ Uint tot_bin_allocated; void erts_init_utils(void) { -#ifdef ERTS_SMP - init_ptimers(); -#endif + } void erts_init_utils_mem(void) diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 518646649d..b2cfe70f94 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1938,6 +1938,8 @@ static void invoke_sendfile(void *data) d->result_ok = 1; if (d->c.sendfile.nbytes != 0) d->c.sendfile.nbytes -= nbytes; + } else if (nbytes == 0 && d->c.sendfile.nbytes == 0) { + d->result_ok = 1; } else d->result_ok = 0; } else { diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 61406b92af..2804d46249 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -213,9 +213,9 @@ void hipe_print_pcb(Process *p) U("seq..clock ", seq_trace_clock); U("seq..astcnt", seq_trace_lastcnt); U("seq..token ", seq_trace_token); - U("intial[0] ", initial[0]); - U("intial[1] ", initial[1]); - U("intial[2] ", initial[2]); + U("intial[0] ", u.initial[0]); + U("intial[1] ", u.initial[1]); + U("intial[2] ", u.initial[2]); P("current ", current); P("cp ", cp); P("i ", i); diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 7e8632b50d..85d945823e 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -102,7 +102,8 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) * p->def_arg_reg[0] and p->i are both defined and used. * If a message arrives, BEAM resumes at p->i. * If a timeout fires, BEAM resumes at p->def_arg_reg[0]. - * (See set_timer() and timeout_proc() in erl_process.c.) + * (See erts_set_proc_timer() and proc_timeout_common() in + * erl_hl_timer.c.) * * Here we set p->def_arg_reg[0] to hipe_beam_pc_resume. * Assuming our caller invokes suspend immediately after @@ -135,28 +136,21 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) */ if (p->flags & (F_INSLPQUEUE | F_TIMO)) return NIL; /* caller had better call nbif_suspend ASAP! */ - if (is_small(timeout_value) && signed_val(timeout_value) >= 0 && -#if defined(ARCH_64) - (unsigned_val(timeout_value) >> 32) == 0 -#else - 1 -#endif - ) { - set_timer(p, unsigned_val(timeout_value)); - } else if (timeout_value == am_infinity) { + + if (timeout_value == am_infinity) { /* p->flags |= F_TIMO; */ /* XXX: nbif_suspend_msg_timeout */ -#if !defined(ARCH_64) - } else if (term_to_Uint(timeout_value, &time_val)) { - set_timer(p, time_val); -#endif - } else { + } + else { + int tres = erts_set_proc_timer_term(p, timeout_value); + if (tres != 0) { /* Wrong time */ #ifdef ERTS_SMP - if (p->hipe_smp.have_receive_locks) { - p->hipe_smp.have_receive_locks = 0; - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); - } + if (p->hipe_smp.have_receive_locks) { + p->hipe_smp.have_receive_locks = 0; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } #endif - BIF_ERROR(p, EXC_TIMEOUT_VALUE); + BIF_ERROR(p, EXC_TIMEOUT_VALUE); + } } return NIL; /* caller had better call nbif_suspend ASAP! */ } @@ -170,7 +164,7 @@ void hipe_select_msg(Process *p) msgp = PEEK_MESSAGE(p); UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */ JOIN_MESSAGE(p); - CANCEL_TIMER(p); /* calls erl_cancel_timer() */ + CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */ free_message(msgp); } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 7be17d20bb..d1d6696090 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -38,6 +38,8 @@ #include "erl_check_io.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS #else @@ -1616,8 +1618,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) /* Figure out timeout value */ timeout_time = (do_wait - ? erts_check_next_timeout_time(esdp->timer_wheel, - ERTS_SEC_TO_MONOTONIC(10*60)) + ? erts_check_next_timeout_time(esdp) : ERTS_POLL_NO_TIMEOUT /* poll only */); /* diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index f4d4a85ca4..71c4239902 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -314,6 +314,9 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fds[2]; #endif +#if ERTS_POLL_USE_TIMERFD + int timer_fd; +#endif #if ERTS_POLL_USE_FALLBACK int fallback_used; #endif @@ -580,6 +583,75 @@ create_wakeup_pipe(ErtsPollSet ps) #endif /* ERTS_POLL_USE_WAKEUP_PIPE */ /* + * --- timer fd ----------------------------------------------------------- + */ + +#if ERTS_POLL_USE_TIMERFD + +/* We use the timerfd when using epoll_wait to get high accuracy + timeouts, i.e. we want to sleep with < ms accuracy. */ + +static void +create_timerfd(ErtsPollSet ps) +{ + int do_wake = 0; + int timer_fd; + timer_fd = timerfd_create(CLOCK_MONOTONIC,0); + ERTS_POLL_EXPORT(erts_poll_control)(ps, + timer_fd, + ERTS_POLL_EV_IN, + 1, &do_wake); +#if ERTS_POLL_USE_FALLBACK + /* We depend on the wakeup pipe being handled by kernel poll */ + if (ps->fds_status[timer_fd].flags & ERTS_POLL_FD_FLG_INFLBCK) + fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n", + __FILE__, __LINE__); +#endif + if (ps->internal_fd_limit <= timer_fd) + ps->internal_fd_limit = timer_fd + 1; + ps->timer_fd = timer_fd; +} + +static ERTS_INLINE void +timerfd_set(ErtsPollSet ps, struct itimerspec *its) +{ +#ifdef DEBUG + struct itimerspec old_its; + int res; + res = timerfd_settime(ps->timer_fd, 0, its, &old_its); + ASSERT(res == 0); + ASSERT(old_its.it_interval.tv_sec == 0 && + old_its.it_interval.tv_nsec == 0 && + old_its.it_value.tv_sec == 0 && + old_its.it_value.tv_nsec == 0); + +#else + timerfd_settime(ps->timer_fd, 0, its, NULL); +#endif +} + +static ERTS_INLINE int +timerfd_clear(ErtsPollSet ps, int res, int max_res) { + + struct itimerspec its; + /* we always have to clear the timer */ + its.it_interval.tv_sec = 0; + its.it_interval.tv_nsec = 0; + its.it_value.tv_sec = 0; + its.it_value.tv_nsec = 0; + timerfd_settime(ps->timer_fd, 0, &its, NULL); + + /* only timeout fd triggered */ + if (res == 1 && ps->res_events[0].data.fd == ps->timer_fd) + return 0; + + return res; +} + +#endif /* ERTS_POLL_USE_TIMERFD */ + + +/* * --- Poll set update requests ---------------------------------------------- */ #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE @@ -1517,6 +1589,12 @@ poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake goto done; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == ps->timer_fd) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } +#endif } if (fd >= ps->fds_status_len) @@ -1664,6 +1742,9 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fd = ps->wake_fds[0]; #endif +#if ERTS_POLL_USE_TIMERFD + int timer_fd = ps->timer_fd; +#endif for (i = 0; i < n; i++) { @@ -1679,6 +1760,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) continue; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == timer_fd) { + continue; + } +#endif ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); /* epoll_wait() can repeat the same fd in result array... */ ix = (int) ps->fds_status[fd].res_ev_ix; @@ -1753,6 +1839,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) continue; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == timer_fd) { + continue; + } +#endif revents = ERTS_POLL_EV_N2E(ps->res_events[i].events); pr[res].fd = fd; pr[res].events = revents; @@ -2026,7 +2117,7 @@ get_timeout(ErtsPollSet ps, } else { ErtsMonotonicTime diff_time, current_time; - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(NULL); diff_time = timeout_time - current_time; if (diff_time <= 0) { save_timeout_time = ERTS_MONOTONIC_TIME_MIN; @@ -2097,7 +2188,7 @@ get_timeout_timeval(ErtsPollSet ps, #endif -#if ERTS_POLL_USE_KQUEUE +#if ERTS_POLL_USE_KQUEUE || (ERTS_POLL_USE_POLL && defined(HAVE_PPOLL)) || ERTS_POLL_USE_TIMERFD static ERTS_INLINE int get_timeout_timespec(ErtsPollSet ps, @@ -2120,7 +2211,7 @@ get_timeout_timespec(ErtsPollSet ps, ASSERT(tsp->tv_sec >= 0); ASSERT(tsp->tv_nsec >= 0); - ASSERT(tsp->tv_nsec < 1000*1000); + ASSERT(tsp->tv_nsec < 1000*1000*1000); return !0; } @@ -2128,6 +2219,22 @@ get_timeout_timespec(ErtsPollSet ps, #endif +#if ERTS_POLL_USE_TIMERFD + +static ERTS_INLINE int +get_timeout_itimerspec(ErtsPollSet ps, + struct itimerspec *itsp, + ErtsMonotonicTime timeout_time) +{ + + itsp->it_interval.tv_sec = 0; + itsp->it_interval.tv_nsec = 0; + + return get_timeout_timespec(ps, &itsp->it_value, timeout_time); +} + +#endif + static ERTS_INLINE int check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) { @@ -2145,12 +2252,29 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) #if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ if (max_res > ps->res_events_len) grow_res_events(ps, max_res); +#if ERTS_POLL_USE_TIMERFD + { + struct itimerspec its; + timeout = get_timeout_itimerspec(ps, &its, timeout_time); + if (timeout) { +#ifdef ERTS_SMP + erts_thr_progress_prepare_wait(NULL); +#endif + timerfd_set(ps, &its); + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1); + res = timerfd_clear(ps, res, max_res); + } else { + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0); + } + } +#else /* !ERTS_POLL_USE_TIMERFD */ timeout = (int) get_timeout(ps, 1000, timeout_time); #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); #endif res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); +#endif /* !ERTS_POLL_USE_TIMERFD */ #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ struct timespec ts; if (max_res > ps->res_events_len) @@ -2189,7 +2313,15 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) #endif poll_res.dp_timeout = timeout; res = ioctl(ps->kp_fd, DP_POLL, &poll_res); -#elif ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ +#elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */ + struct timespec ts; + timeout = get_timeout_timespec(ps, &ts, timeout_time); +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif + 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); #ifdef ERTS_SMP if (timeout) @@ -2202,7 +2334,7 @@ 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); - + #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); @@ -2535,6 +2667,9 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) #if ERTS_POLL_USE_WAKEUP_PIPE create_wakeup_pipe(ps); #endif +#if ERTS_POLL_USE_TIMERFD + create_timerfd(ps); +#endif #if ERTS_POLL_USE_FALLBACK if (kp_fd >= ps->fds_status_len) grow_fds_status(ps, kp_fd); @@ -2625,6 +2760,10 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps) if (ps->wake_fds[1] >= 0) close(ps->wake_fds[1]); #endif +#if ERTS_POLL_USE_TIMERFD + if (ps->timer_fd >= 0) + close(ps->timer_fd); +#endif erts_smp_spin_lock(&pollsets_lock); if (ps == pollsets) @@ -2729,6 +2868,9 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip) #if ERTS_POLL_USE_WAKEUP_PIPE pip->poll_set_size++; /* Wakeup pipe */ #endif +#if ERTS_POLL_USE_TIMERFD + pip->poll_set_size++; /* timerfd */ +#endif pip->fallback_poll_set_size = #if !ERTS_POLL_USE_FALLBACK @@ -2857,14 +2999,18 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps, ev[fd] = 0; else { ev[fd] = ps->fds_status[fd].events; + if ( #if ERTS_POLL_USE_WAKEUP_PIPE - if (fd == ps->wake_fds[0] || fd == ps->wake_fds[1]) - ev[fd] |= ERTS_POLL_EV_NVAL; + fd == ps->wake_fds[0] || fd == ps->wake_fds[1] || +#endif +#if ERTS_POLL_USE_TIMERFD + fd == ps->timer_fd || #endif #if ERTS_POLL_USE_KERNEL_POLL - if (fd == ps->kp_fd) - ev[fd] |= ERTS_POLL_EV_NVAL; + fd == ps->kp_fd || #endif + 0) + ev[fd] |= ERTS_POLL_EV_NVAL; } } ERTS_POLLSET_UNLOCK(ps); diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index d02ed2396b..ae2d063805 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -98,6 +98,8 @@ # endif #endif +#define ERTS_POLL_USE_TIMERFD 0 + typedef Uint32 ErtsPollEvents; #undef ERTS_POLL_EV_E2N @@ -130,6 +132,12 @@ struct erts_sys_fd_type { #include <sys/epoll.h> +#ifdef HAVE_SYS_TIMERFD_H +#include <sys/timerfd.h> +#undef ERTS_POLL_USE_TIMERFD +#define ERTS_POLL_USE_TIMERFD 1 +#endif + #define ERTS_POLL_EV_E2N(EV) \ ((__uint32_t) (EV)) #define ERTS_POLL_EV_N2E(EV) \ diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c index 36ee2557e8..3d4ac0365f 100644 --- a/erts/emulator/sys/ose/erl_poll.c +++ b/erts/emulator/sys/ose/erl_poll.c @@ -506,7 +506,7 @@ int erts_poll_wait(ErtsPollSet ps, } else { ErtsMonotonicTime current_time, diff_time; - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(NULL); diff_time = timeout_time - current_time; if (diff_time <= 0) goto no_timeout; diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 5ad92dad02..d050748703 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -55,7 +55,7 @@ void sys_sigrelease(int sig) #endif /* !SIG_SIGSET */ #if defined(__ANDROID__) -int __system_properties_fd(void); +static int system_properties_fd(void); #endif /* __ANDROID__ */ #if defined(__ANDROID__) @@ -104,9 +104,12 @@ main(int argc, char *argv[]) #if defined(HAVE_CLOSEFROM) closefrom(from); #elif defined(__ANDROID__) - for (i = from; i <= to; i++) { - if (i!=__system_properties_fd) - (void) close(i); + if (from <= to) { + int spfd = system_properties_fd(); + for (i = from; i <= to; i++) { + if (i != spfd) + (void) close(i); + } } #else for (i = from; i <= to; i++) @@ -143,9 +146,9 @@ main(int argc, char *argv[]) } #if defined(__ANDROID__) -int __system_properties_fd(void) +static int system_properties_fd(void) { - int s, fd; + int fd; char *env; env = getenv("ANDROID_PROPERTY_WORKSPACE"); @@ -156,4 +159,3 @@ int __system_properties_fd(void) return fd; } #endif /* __ANDROID__ */ - diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 94adcc00c8..1942b631fc 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -177,10 +177,10 @@ typedef ErtsMonotonicTime ErtsSystemTime; /* * OS monotonic time and OS system time */ - #undef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ -#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) \ + && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) # if defined(__linux__) # define ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ 1 # endif @@ -191,13 +191,11 @@ ErtsSystemTime erts_os_system_time(void); #undef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT #undef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT #undef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ -#undef ERTS_HAVE_CORRECTED_OS_MONOTONIC #if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) # define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1 # define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000) # if defined(__linux__) -# define ERTS_HAVE_CORRECTED_OS_MONOTONIC 1 # define ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ 1 # endif #elif defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 2ffa649767..c30ef7cce2 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -85,7 +85,7 @@ static void set_current_fp_exception(unsigned long pc) void erts_fp_check_init_error(volatile unsigned long *fpexnp) { - char buf[64]; + char buf[128]; snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n", __builtin_return_address(0), (void*)*fpexnp); if (write(2, buf, strlen(buf)) <= 0) diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index d535457977..dc1822b21c 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -31,6 +31,7 @@ # undef _FILE_OFFSET_BITS #endif +#include <stdlib.h> #include "sys.h" #include "global.h" #include "erl_os_monotonic_time_extender.h" @@ -39,14 +40,11 @@ #undef ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ #if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \ - || defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) -# include <mach/clock.h> -# include <mach/mach.h> -# ifdef HAVE_CLOCK_GET_ATTRIBUTES -# define ERTS_HAVE_MACH_CLOCK_GETRES -static Sint64 -mach_clock_getres(clock_id_t clkid, char *clkid_str); -# endif + || defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) \ + || defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) +# include <mach/clock.h> +# include <mach/mach.h> +# define ERTS_MACH_CLOCKS #endif #ifdef NO_SYSCONF @@ -99,20 +97,53 @@ ErtsSysTimeData__ erts_sys_time_data__ erts_align_attribute(ERTS_CACHE_LINE_SIZE #define ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ -static ErtsMonotonicTime clock_gettime_monotonic_raw(void); +static ErtsMonotonicTime clock_gettime_monotonic(void); static ErtsMonotonicTime clock_gettime_monotonic_verified(void); +#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) +static ErtsMonotonicTime clock_gettime_monotonic_raw(void); +#endif #if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) -static void clock_gettime_times_raw(ErtsMonotonicTime *, ErtsSystemTime *); +static void clock_gettime_times(ErtsMonotonicTime *, ErtsSystemTime *); static void clock_gettime_times_verified(ErtsMonotonicTime *, ErtsSystemTime *); +#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) +static void clock_gettime_times_raw(ErtsMonotonicTime *, ErtsSystemTime *); +#endif #endif #endif /* defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) */ +#ifdef ERTS_MACH_CLOCKS +# define ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__ +typedef struct { + clock_id_t id; + clock_serv_t srv; + char *name; +} ErtsMachClock; + +typedef struct { + host_name_port_t host; + struct { + ErtsMachClock monotonic; + ErtsMachClock wall; + } clock; +} ErtsMachClocks; +static void mach_clocks_init(void); +static void mach_clocks_fini(void); +# ifdef HAVE_CLOCK_GET_ATTRIBUTES +# define ERTS_HAVE_MACH_CLOCK_GETRES +static Sint64 +mach_clock_getres(ErtsMachClock *clk); +# endif +#endif /* ERTS_MACH_CLOCKS */ + #ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__ struct sys_time_internal_state_read_only__ { #if defined(OS_MONOTONIC_TIME_USING_TIMES) int times_shift; #endif +#ifdef ERTS_MACH_CLOCKS + ErtsMachClocks mach; +#endif }; #endif @@ -166,13 +197,23 @@ static struct { void sys_init_time(ErtsSysInitTimeResult *init_resp) { +#if defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) + int major, minor, build, vsn; +#endif +#if defined(ERTS_MACH_CLOCKS) + mach_clocks_init(); +#endif #if !defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) init_resp->have_os_monotonic_time = 0; #else /* defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) */ - int major, minor, build, vsn; +#ifdef ERTS_HAVE_CORRECTED_OS_MONOTONIC_TIME + init_resp->have_corrected_os_monotonic_time = 1; +#else + init_resp->have_corrected_os_monotonic_time = 0; +#endif init_resp->os_monotonic_time_info.resolution = (Uint64) 1000*1000*1000; #if defined(HAVE_CLOCK_GETRES) && defined(MONOTONIC_CLOCK_ID) @@ -187,7 +228,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) } #elif defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(MONOTONIC_CLOCK_ID) init_resp->os_monotonic_time_info.resolution - = mach_clock_getres(MONOTONIC_CLOCK_ID, MONOTONIC_CLOCK_ID_STR); + = mach_clock_getres(&internal_state.r.o.mach.clock.monotonic); #endif #ifdef MONOTONIC_CLOCK_ID_STR @@ -220,29 +261,52 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) #if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) if (vsn >= ERTS_MK_VSN_INT(2, 6, 33)) { erts_sys_time_data__.r.o.os_monotonic_time = - clock_gettime_monotonic_raw; + clock_gettime_monotonic; #if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) erts_sys_time_data__.r.o.os_times = - clock_gettime_times_raw; + clock_gettime_times; #endif } else { /* * Linux versions prior to 2.6.33 have a - * known bug that sometimes cause monotonic - * time to take small steps backwards. + * known bug that sometimes cause the NTP + * adjusted monotonic clock to take small + * steps backwards. Use raw monotonic clock + * if it is present; otherwise, fall back + * on locked verification of values. */ - erts_sys_time_data__.r.o.os_monotonic_time = - clock_gettime_monotonic_verified; + init_resp->have_corrected_os_monotonic_time = 0; +#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) + /* We know that CLOCK_MONOTONIC_RAW is defined, + but we don't know if we got a kernel that + supports it. Support for CLOCK_MONOTONIC_RAW + appeared in kernel 2.6.28... */ + if (vsn >= ERTS_MK_VSN_INT(2, 6, 28)) { + erts_sys_time_data__.r.o.os_monotonic_time = + clock_gettime_monotonic_raw; #if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) - erts_sys_time_data__.r.o.os_times = - clock_gettime_times_verified; + erts_sys_time_data__.r.o.os_times = + clock_gettime_times_raw; #endif - erts_smp_mtx_init(&internal_state.w.f.mtx, - "os_monotonic_time"); - internal_state.w.f.last_delivered - = clock_gettime_monotonic_raw(); - init_resp->os_monotonic_time_info.locked_use = 1; + init_resp->os_monotonic_time_info.clock_id = + "CLOCK_MONOTONIC_RAW"; + } + else +#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */ + { + erts_sys_time_data__.r.o.os_monotonic_time = + clock_gettime_monotonic_verified; +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + erts_sys_time_data__.r.o.os_times = + clock_gettime_times_verified; +#endif + erts_smp_mtx_init(&internal_state.w.f.mtx, + "os_monotonic_time"); + internal_state.w.f.last_delivered + = clock_gettime_monotonic(); + init_resp->os_monotonic_time_info.locked_use = 1; + } } #else /* !(defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)) */ { @@ -324,7 +388,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) } #elif defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(WALL_CLOCK_ID) init_resp->os_system_time_info.resolution - = mach_clock_getres(WALL_CLOCK_ID, WALL_CLOCK_ID_STR); + = mach_clock_getres(&internal_state.r.o.mach.clock.wall); #endif #if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) @@ -366,6 +430,10 @@ adj_stime_time_unit(ErtsSystemTime stime, Uint32 res) (Uint32) ERTS_MONOTONIC_TIME_UNIT)); } +#define ERTS_TimeSpec2Sint64(TS) \ + ((((Sint64) (TS)->tv_sec) * ((Sint64) 1000*1000*1000)) \ + + ((Sint64) (TS)->tv_nsec)) + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * POSIX clock_gettime() * \* */ @@ -373,17 +441,7 @@ adj_stime_time_unit(ErtsSystemTime stime, Uint32 res) #if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \ || defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) -static ERTS_INLINE ErtsMonotonicTime -timespec2montime(struct timespec *ts) -{ - ErtsMonotonicTime time; - time = (ErtsMonotonicTime) ts->tv_sec; - time *= (ErtsMonotonicTime) 1000*1000*1000; - time += (ErtsMonotonicTime) ts->tv_nsec; - return time; -} - -static ERTS_INLINE ErtsMonotonicTime +static ERTS_INLINE Sint64 posix_clock_gettime(clockid_t id, char *name) { struct timespec ts; @@ -395,7 +453,7 @@ posix_clock_gettime(clockid_t id, char *name) "clock_gettime(%s, _) failed: %s (%d)\n", name, errstr, err); } - return timespec2montime(&ts); + return ERTS_TimeSpec2Sint64(&ts); } #endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \ @@ -406,11 +464,10 @@ posix_clock_gettime(clockid_t id, char *name) ErtsSystemTime erts_os_system_time(void) { - ErtsSystemTime stime; - - stime = (ErtsSystemTime) posix_clock_gettime(WALL_CLOCK_ID, - WALL_CLOCK_ID_STR); - return adj_stime_time_unit(stime, (Uint32) 1000*1000*1000); + Sint64 stime = posix_clock_gettime(WALL_CLOCK_ID, + WALL_CLOCK_ID_STR); + return adj_stime_time_unit((ErtsSystemTime) stime, + (Uint32) 1000*1000*1000); } #endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ @@ -422,32 +479,34 @@ erts_os_system_time(void) #define ERTS_HAVE_ERTS_OS_TIMES_IMPL__ static ERTS_INLINE void -posix_clock_gettime_times(ErtsMonotonicTime *mtimep, +posix_clock_gettime_times(clockid_t mid, char *mname, + ErtsMonotonicTime *mtimep, + clockid_t sid, char *sname, ErtsSystemTime *stimep) { struct timespec mts, sts; int mres, sres, merr, serr; - mres = clock_gettime(MONOTONIC_CLOCK_ID, &mts); + mres = clock_gettime(mid, &mts); merr = errno; - sres = clock_gettime(WALL_CLOCK_ID, &sts); + sres = clock_gettime(sid, &sts); serr = errno; if (mres != 0) { char *errstr = merr ? strerror(merr) : "unknown"; erl_exit(ERTS_ABORT_EXIT, "clock_gettime(%s, _) failed: %s (%d)\n", - MONOTONIC_CLOCK_ID_STR, errstr, merr); + mname, errstr, merr); } if (sres != 0) { char *errstr = serr ? strerror(serr) : "unknown"; erl_exit(ERTS_ABORT_EXIT, "clock_gettime(%s, _) failed: %s (%d)\n", - WALL_CLOCK_ID_STR, errstr, serr); + sname, errstr, serr); } - *mtimep = timespec2montime(&mts); - *stimep = (ErtsSystemTime) timespec2montime(&sts); + *mtimep = (ErtsMonotonicTime) ERTS_TimeSpec2Sint64(&mts); + *stimep = (ErtsSystemTime) ERTS_TimeSpec2Sint64(&sts); } #endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ @@ -456,8 +515,10 @@ posix_clock_gettime_times(ErtsMonotonicTime *mtimep, static ErtsMonotonicTime clock_gettime_monotonic_verified(void) { - ErtsMonotonicTime mtime = posix_clock_gettime(MONOTONIC_CLOCK_ID, - MONOTONIC_CLOCK_ID_STR); + ErtsMonotonicTime mtime; + + mtime = (ErtsMonotonicTime) posix_clock_gettime(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR); erts_smp_mtx_lock(&internal_state.w.f.mtx); if (mtime < internal_state.w.f.last_delivered) @@ -474,7 +535,12 @@ static ErtsMonotonicTime clock_gettime_monotonic_verified(void) static void clock_gettime_times_verified(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - posix_clock_gettime_times(mtimep, stimep); + posix_clock_gettime_times(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR, + mtimep, + WALL_CLOCK_ID, + WALL_CLOCK_ID_STR, + stimep); erts_smp_mtx_lock(&internal_state.w.f.mtx); if (*mtimep < internal_state.w.f.last_delivered) @@ -486,20 +552,50 @@ static void clock_gettime_times_verified(ErtsMonotonicTime *mtimep, #endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ +static ErtsMonotonicTime clock_gettime_monotonic(void) +{ + return (ErtsMonotonicTime) posix_clock_gettime(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR); +} + +#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) + static ErtsMonotonicTime clock_gettime_monotonic_raw(void) { - return posix_clock_gettime(MONOTONIC_CLOCK_ID, - MONOTONIC_CLOCK_ID_STR); + return (ErtsMonotonicTime) posix_clock_gettime(CLOCK_MONOTONIC_RAW, + "CLOCK_MONOTONIC_RAW"); } +#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */ + #if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) +static void clock_gettime_times(ErtsMonotonicTime *mtimep, + ErtsSystemTime *stimep) +{ + posix_clock_gettime_times(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR, + mtimep, + WALL_CLOCK_ID, + WALL_CLOCK_ID_STR, + stimep); +} + +#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) + static void clock_gettime_times_raw(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - posix_clock_gettime_times(mtimep, stimep); + posix_clock_gettime_times(CLOCK_MONOTONIC_RAW, + "CLOCK_MONOTONIC_RAW", + mtimep, + WALL_CLOCK_ID, + WALL_CLOCK_ID_STR, + stimep); } +#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */ + #endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ #else /* !defined(__linux__) */ @@ -514,61 +610,116 @@ ErtsMonotonicTime erts_os_monotonic_time(void) void erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - posix_clock_gettime_times(mtimep, stimep); + posix_clock_gettime_times(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR, + mtimep, + WALL_CLOCK_ID, + WALL_CLOCK_ID_STR, + stimep); } #endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ #endif /* !defined(__linux__) */ -#define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ +#endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) */ + +#if defined(SYS_HRTIME_USING_CLOCK_GETTIME) +# define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ ErtsSysHrTime erts_sys_hrtime(void) { - return (ErtsSysHrTime) posix_clock_gettime(MONOTONIC_CLOCK_ID, - MONOTONIC_CLOCK_ID_STR); + return (ErtsSysHrTime) posix_clock_gettime(HRTIME_CLOCK_ID, + HRTIME_CLOCK_ID_STR); } -#endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) */ +#endif /* defined(SYS_HRTIME_USING_CLOCK_GETTIME) */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * MACH clock_get_time() * \* */ -#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \ - || defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) +#if defined(ERTS_MACH_CLOCKS) -#ifdef ERTS_HAVE_MACH_CLOCK_GETRES +static void +mach_clocks_fini(void) +{ + mach_port_t task = mach_task_self(); + mach_port_deallocate(task, internal_state.r.o.mach.host); +#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) + mach_port_deallocate(task, internal_state.r.o.mach.clock.monotonic.srv); +#endif +#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) + mach_port_deallocate(task, internal_state.r.o.mach.clock.wall.srv); +#endif +} -static Sint64 -mach_clock_getres(clock_id_t clkid, char *clkid_str) +static void +mach_clocks_init(void) { - mach_port_t task; - host_name_port_t host; - natural_t attr[1]; kern_return_t kret; - clock_serv_t clk_srv; - mach_msg_type_number_t cnt; + host_name_port_t host; + clock_id_t id; + clock_serv_t *clck_srv_p; + char *name; + + host = internal_state.r.o.mach.host = mach_host_self(); - host = mach_host_self(); - kret = host_get_clock_service(host, clkid, &clk_srv); +#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \ + || defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) + id = internal_state.r.o.mach.clock.monotonic.id = MONOTONIC_CLOCK_ID; + name = internal_state.r.o.mach.clock.monotonic.name = MONOTONIC_CLOCK_ID_STR; + clck_srv_p = &internal_state.r.o.mach.clock.monotonic.srv; + kret = host_get_clock_service(host, id, clck_srv_p); if (kret != KERN_SUCCESS) { erl_exit(ERTS_ABORT_EXIT, "host_get_clock_service(_, %s, _) failed\n", - clkid_str); + name); } +#endif - cnt = sizeof(attr); - kret = clock_get_attributes(clk_srv, CLOCK_GET_TIME_RES, (clock_attr_t) attr, &cnt); +#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) + id = internal_state.r.o.mach.clock.wall.id = WALL_CLOCK_ID; + name = internal_state.r.o.mach.clock.wall.name = WALL_CLOCK_ID_STR; + clck_srv_p = &internal_state.r.o.mach.clock.wall.srv; + kret = host_get_clock_service(host, id, clck_srv_p); if (kret != KERN_SUCCESS) { + erl_exit(ERTS_ABORT_EXIT, + "host_get_clock_service(_, %s, _) failed\n", + name); + } +#endif + + if (atexit(mach_clocks_fini) != 0) { + int err = errno; + char *errstr = err ? strerror(err) : "unknown"; + erl_exit(ERTS_ABORT_EXIT, + "Failed to register mach_clocks_fini() " + "for call at exit: %s (%d)\n", + errstr, err); + } +} + +#ifdef ERTS_HAVE_MACH_CLOCK_GETRES + +static Sint64 +mach_clock_getres(ErtsMachClock *clk) +{ + kern_return_t kret; + natural_t attr[1]; + mach_msg_type_number_t cnt; + + cnt = sizeof(attr); + kret = clock_get_attributes(clk->srv, + CLOCK_GET_TIME_RES, + (clock_attr_t) attr, + &cnt); + if (kret != KERN_SUCCESS || cnt != 1) { erl_exit(ERTS_ABORT_EXIT, "clock_get_attributes(%s, _) failed\n", - clkid_str); + clk->name); } - task = mach_task_self(); - mach_port_deallocate(task, host); - mach_port_deallocate(task, clk_srv); return (Sint64) attr[0]; } @@ -576,41 +727,19 @@ mach_clock_getres(clock_id_t clkid, char *clkid_str) #endif /* ERTS_HAVE_MACH_CLOCK_GETRES */ static ERTS_INLINE Sint64 -mach_clock_gettime(clock_id_t clkid, char *clkid_str) +mach_clock_get_time(ErtsMachClock *clk) { - Sint64 time; - mach_port_t task; - host_name_port_t host; kern_return_t kret; - clock_serv_t clk_srv; mach_timespec_t time_spec; - host = mach_host_self(); - kret = host_get_clock_service(host, clkid, &clk_srv); - if (kret != KERN_SUCCESS) { - erl_exit(ERTS_ABORT_EXIT, - "host_get_clock_service(_, %s, _) failed\n", - clkid_str); - } - errno = 0; - kret = clock_get_time(clk_srv, &time_spec); - if (kret != KERN_SUCCESS) { - erl_exit(ERTS_ABORT_EXIT, - "clock_get_time(%s, _) failed\n", - clkid_str); - } - task = mach_task_self(); - mach_port_deallocate(task, host); - mach_port_deallocate(task, clk_srv); + kret = clock_get_time(clk->srv, &time_spec); + if (kret != KERN_SUCCESS) + erl_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", clk->name); - time = (Sint64) time_spec.tv_sec; - time *= (Sint64) 1000*1000*1000; - time += (Sint64) time_spec.tv_nsec; - return time; + return ERTS_TimeSpec2Sint64(&time_spec); } -#endif /* defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \ - || defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) */ +#endif /* defined(ERTS_MACH_CLOCKS) */ #if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) @@ -619,10 +748,9 @@ mach_clock_gettime(clock_id_t clkid, char *clkid_str) ErtsSystemTime erts_os_system_time(void) { - ErtsSystemTime stime; - stime = (ErtsSystemTime) mach_clock_gettime(WALL_CLOCK_ID, - WALL_CLOCK_ID_STR); - return adj_stime_time_unit(stime, (Uint32) 1000*1000*1000); + Sint64 stime = mach_clock_get_time(&internal_state.r.o.mach.clock.wall); + return adj_stime_time_unit((ErtsSystemTime) stime, + (Uint32) 1000*1000*1000); } #endif /* defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) */ @@ -632,17 +760,8 @@ erts_os_system_time(void) ErtsMonotonicTime erts_os_monotonic_time(void) { - return (ErtsMonotonicTime) mach_clock_gettime(MONOTONIC_CLOCK_ID, - MONOTONIC_CLOCK_ID_STR); -} - -#define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ - -ErtsSysHrTime -erts_sys_hrtime(void) -{ - return (ErtsMonotonicTime) mach_clock_gettime(MONOTONIC_CLOCK_ID, - MONOTONIC_CLOCK_ID_STR); + return (ErtsMonotonicTime) + mach_clock_get_time(&internal_state.r.o.mach.clock.monotonic); } #if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) @@ -652,58 +771,44 @@ erts_sys_hrtime(void) void erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - ErtsMonotonicTime mtime; - ErtsSystemTime stime; - mach_port_t task; - host_name_port_t host; kern_return_t mkret, skret; - clock_serv_t mclk_srv, sclk_srv; mach_timespec_t mon_time_spec, sys_time_spec; - host = mach_host_self(); - mkret = host_get_clock_service(host, MONOTONIC_CLOCK_ID, &mclk_srv); - skret = host_get_clock_service(host, WALL_CLOCK_ID, &sclk_srv); - if (mkret != KERN_SUCCESS) { - erl_exit(ERTS_ABORT_EXIT, - "host_get_clock_service(_, %s, _) failed\n", - MONOTONIC_CLOCK_ID); - } - if (skret != KERN_SUCCESS) { - erl_exit(ERTS_ABORT_EXIT, - "host_get_clock_service(_, %s, _) failed\n", - WALL_CLOCK_ID); - } - mkret = clock_get_time(mclk_srv, &mon_time_spec); - skret = clock_get_time(sclk_srv, &sys_time_spec); - if (mkret != KERN_SUCCESS) { + mkret = clock_get_time(internal_state.r.o.mach.clock.monotonic.srv, + &mon_time_spec); + skret = clock_get_time(internal_state.r.o.mach.clock.wall.srv, + &sys_time_spec); + + if (mkret != KERN_SUCCESS) erl_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", - MONOTONIC_CLOCK_ID); - } - if (skret != KERN_SUCCESS) { + internal_state.r.o.mach.clock.monotonic.name); + if (skret != KERN_SUCCESS) erl_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", - WALL_CLOCK_ID); - } - task = mach_task_self(); - mach_port_deallocate(task, host); - mach_port_deallocate(task, mclk_srv); - mach_port_deallocate(task, sclk_srv); + internal_state.r.o.mach.clock.wall.name); - mtime = (ErtsMonotonicTime) mon_time_spec.tv_sec; - mtime *= (ErtsMonotonicTime) 1000*1000*1000; - mtime += (ErtsMonotonicTime) mon_time_spec.tv_nsec; - stime = (ErtsSystemTime) sys_time_spec.tv_sec; - stime *= (ErtsSystemTime) 1000*1000*1000; - stime += (ErtsSystemTime) sys_time_spec.tv_nsec; - *mtimep = mtime; - *stimep = stime; + *mtimep = (ErtsMonotonicTime) ERTS_TimeSpec2Sint64(&mon_time_spec); + *stimep = (ErtsSystemTime) ERTS_TimeSpec2Sint64(&sys_time_spec); } #endif /* defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) */ #endif /* defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) */ +#if defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) + +#define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ + +ErtsSysHrTime +erts_sys_hrtime(void) +{ + return (ErtsSysHrTime) + mach_clock_get_time(&internal_state.r.o.mach.clock.monotonic); +} + +#endif /* defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) */ + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Solaris gethrtime() - OS monotonic time * \* */ @@ -715,6 +820,10 @@ ErtsMonotonicTime erts_os_monotonic_time(void) return (ErtsMonotonicTime) gethrtime(); } +#endif /* defined(OS_MONOTONIC_TIME_USING_GETHRTIME) */ + +#if defined(SYS_HRTIME_USING_GETHRTIME) + #define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ ErtsSysHrTime @@ -723,7 +832,7 @@ erts_sys_hrtime(void) return (ErtsSysHrTime) gethrtime(); } -#endif /* defined(OS_MONOTONIC_TIME_USING_GETHRTIME) */ +#endif /* defined(SYS_HRTIME_USING_GETHRTIME) */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * gettimeofday() - OS system time * diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 5a62b00a68..9196561944 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -25,6 +25,7 @@ #include "sys.h" #include "erl_alloc.h" #include "erl_poll.h" +#include "erl_time.h" /* * Some debug macros @@ -453,7 +454,7 @@ poll_wait_timeout(ErtsPollSet ps, ErtsMonotonicTime timeout_time) return (DWORD) 0; } - current_time = erts_get_monotonic_time(); + current_time = erts_get_monotonic_time(NULL); diff_time = timeout_time - current_time; if (diff_time <= 0) goto no_timeout; diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 714e7357d4..a9e37e47a7 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -224,7 +224,7 @@ erts_os_monotonic_time(void) ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - return (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); + (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); } ERTS_GLB_INLINE ErtsSysHrTime diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index b292d9279e..7da060a7a7 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -28,6 +28,9 @@ #include "erl_os_monotonic_time_extender.h" #include "erl_time.h" +/* Need to look more closely at qpc before use... */ +#define ERTS_DISABLE_USE_OF_QPC_FOR_MONOTONIC_TIME 1 + #define LL_LITERAL(X) ERTS_I64_LITERAL(X) /******************* Routines for time measurement *********************/ @@ -362,10 +365,11 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) if (!internal_state.r.o.pQueryPerformanceCounter) goto get_tick_count64; - if (pf.QuadPart < (((LONGLONG) 1) << 32)) { - internal_state.r.o.pcf = (Uint32) pf.QuadPart; - sys_hrtime_func = sys_hrtime_qpc; - } + if (pf.QuadPart > (((LONGLONG) 1) << 32)) + goto get_tick_count64; + + internal_state.r.o.pcf = (Uint32) pf.QuadPart; + sys_hrtime_func = sys_hrtime_qpc; /* * We only use QueryPerformanceCounter() for @@ -377,6 +381,9 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) if (pf.QuadPart < (LONGLONG) 1000*1000*1000) goto get_tick_count64; + if (ERTS_DISABLE_USE_OF_QPC_FOR_MONOTONIC_TIME) + goto get_tick_count64; + init_resp->os_monotonic_time_info.func = "QueryPerformanceCounter"; init_resp->os_monotonic_time_info.locked_use = 0; time_unit = (ErtsMonotonicTime) pf.QuadPart; @@ -391,6 +398,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) erts_sys_time_data__.r.o.os_times = os_times_func; init_resp->os_monotonic_time_unit = time_unit; init_resp->have_os_monotonic_time = 1; + init_resp->have_corrected_os_monotonic_time = 0; init_resp->sys_clock_resolution = 1; init_resp->os_system_time_info.func = "GetSystemTime"; diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index 7cc329cc69..c855481489 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -27,7 +27,8 @@ init_per_group/2,end_per_group/2, t_after/1, receive_after/1, receive_after_big/1, receive_after_errors/1, receive_var_zero/1, receive_zero/1, - multi_timeout/1, receive_after_32bit/1]). + multi_timeout/1, receive_after_32bit/1, + receive_after_blast/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -40,7 +41,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [t_after, receive_after, receive_after_big, receive_after_errors, receive_var_zero, receive_zero, - multi_timeout, receive_after_32bit]. + multi_timeout, receive_after_32bit, receive_after_blast]. groups() -> []. @@ -70,30 +71,23 @@ end_per_testcase(_Func, Config) -> t_after(Config) when is_list(Config) -> ?line spawn(fun frequent_process/0), ?line Period = test_server:minutes(1), - ?line Before = erlang:now(), + ?line Before = erlang:monotonic_time(), receive after Period -> - ?line After = erlang:now(), + ?line After = erlang:monotonic_time(), ?line report(Period, Before, After) end. - report(Period, Before, After) -> - ?line Elapsed = (element(1, After)*1000000000 - +element(2, After)*1000 - +element(3, After) div 1000) - - (element(1,Before)*1000000000 - + element(2,Before)*1000 + element(3,Before) div 1000), - ?line case Elapsed*100 / Period of - Percent when Percent > 100.10 -> - ?line test_server:fail({too_inaccurate, Percent}); - Percent when Percent < 100.0 -> - ?line test_server:fail({too_early, Percent}); - Percent -> - ?line Comment = io_lib:format("Elapsed/expected: ~.2f %", - [Percent]), - {comment, lists:flatten(Comment)} - end. + case erlang:convert_time_unit(After - Before, native, 100*1000) / Period of + Percent when Percent > 100.10 -> + test_server:fail({too_inaccurate, Percent}); + Percent when Percent < 100.0 -> + test_server:fail({too_early, Percent}); + Percent -> + Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]), + {comment, lists:flatten(Comment)} + end. frequent_process() -> receive @@ -251,4 +245,26 @@ recv_after_32bit(I, T) when I rem 2 =:= 0 -> receive after T -> exit(timeout) end; recv_after_32bit(_, _) -> receive after 16#ffffFFFF -> exit(timeout) end. - + +blaster() -> + receive + {go, TimeoutTime} -> + Tmo = TimeoutTime - erlang:monotonic_time(milli_seconds), + receive after Tmo -> ok end + end. + +spawn_blasters(0) -> + []; +spawn_blasters(N) -> + [spawn_monitor(fun () -> blaster() end)|spawn_blasters(N-1)]. + +receive_after_blast(Config) when is_list(Config) -> + PMs = spawn_blasters(10000), + TimeoutTime = erlang:monotonic_time(milli_seconds) + 5000, + lists:foreach(fun ({P, _}) -> P ! {go, TimeoutTime} end, PMs), + lists:foreach(fun ({P, M}) -> + receive + {'DOWN', M, process, P, normal} -> + ok + end + end, PMs). diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 35c44c229a..12a48cc484 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -241,18 +241,15 @@ receive_drv_result(Port, CaseName) -> start_node(Config) -> start_node(Config, []). start_node(Config, Opts) when is_list(Config), is_list(Opts) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). stop_node(Node) -> ?t:stop_node(Node). diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 44e9e4f243..5911652447 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -520,7 +520,9 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit -> external_size_1(_, _, _) -> ok. t_iolist_size(Config) when is_list(Config) -> - ?line Seed = now(), + ?line Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer([positive])}, ?line io:format("Seed: ~p", [Seed]), ?line random:seed(Seed), ?line Base = <<0:(1 bsl 20)/unit:8>>, diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 2ed5aaa0d0..d44a03516a 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -516,13 +516,13 @@ hs_busy_pcmd(Prt, Opts, StartFun, EndFun) -> P = spawn_link(fun () -> erlang:yield(), Tester ! {self(), doing_port_command}, - Start = now(), + Start = erlang:monotonic_time(micro_seconds), Res = try {return, port_command(Prt, [], Opts)} catch Exception:Error -> {Exception, Error} end, - End = now(), - Time = round(timer:now_diff(End, Start)/1000), + End = erlang:monotonic_time(micro_seconds), + Time = round((End - Start)/1000), Tester ! {self(), port_command_result, Res, Time} end), receive @@ -776,7 +776,7 @@ run_command(_M,spawn,{Args,Opts}) -> run_command(M,spawn,Args) -> run_command(M,spawn,{Args,[]}); run_command(Mod,Func,Args) -> - erlang:display({{Mod,Func,Args},now()}), + erlang:display({{Mod,Func,Args}, erlang:system_time(micro_seconds)}), apply(Mod,Func,Args). validate_scenario(Data,[{print,Var}|T]) -> diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index b0408cabe1..df7c8ed1d1 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -389,61 +389,63 @@ module_md5_ok(Code) -> make_stub(Config) when is_list(Config) -> catch erlang:purge_module(my_code_test), + MD5 = erlang:md5(<<>>), ?line Data = ?config(data_dir, Config), ?line File = filename:join(Data, "my_code_test"), ?line {ok,my_code_test,Code} = compile:file(File, [binary]), - ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[]}), + ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}), ?line true = erlang:delete_module(my_code_test), ?line true = erlang:purge_module(my_code_test), ?line my_code_test = code:make_stub_module(my_code_test, make_unaligned_sub_binary(Code), - {[],[]}), + {[],[],MD5}), ?line true = erlang:delete_module(my_code_test), ?line true = erlang:purge_module(my_code_test), ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), - {[],[]}), + {[],[],MD5}), ?line true = erlang:delete_module(my_code_test), ?line true = erlang:purge_module(my_code_test), %% Should fail. ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[]})), + (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})), ?line {'EXIT',{badarg,_}} = (catch code:make_stub_module(my_code_test, bit_sized_binary(Code), - {[],[]})), + {[],[],MD5})), ?line {'EXIT',{badarg,_}} = (catch code:make_stub_module(my_code_test_with_wrong_name, - Code, {[],[]})), + Code, {[],[],MD5})), ok. make_stub_many_funs(Config) when is_list(Config) -> catch erlang:purge_module(many_funs), + MD5 = erlang:md5(<<>>), ?line Data = ?config(data_dir, Config), ?line File = filename:join(Data, "many_funs"), ?line {ok,many_funs,Code} = compile:file(File, [binary]), - ?line many_funs = code:make_stub_module(many_funs, Code, {[],[]}), + ?line many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}), ?line true = erlang:delete_module(many_funs), ?line true = erlang:purge_module(many_funs), ?line many_funs = code:make_stub_module(many_funs, make_unaligned_sub_binary(Code), - {[],[]}), + {[],[],MD5}), ?line true = erlang:delete_module(many_funs), ?line true = erlang:purge_module(many_funs), %% Should fail. ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, <<"bad">>, {[],[]})), + (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), ?line {'EXIT',{badarg,_}} = (catch code:make_stub_module(many_funs, bit_sized_binary(Code), - {[],[]})), + {[],[],MD5})), ok. constant_pools(Config) when is_list(Config) -> diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 2baf91cf29..330ad299e5 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -52,7 +52,9 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Seed = {S1,S2,S3} = now(), + Seed = {S1,S2,S3} = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, random:seed(S1,S2,S3), io:format("*** SEED: ~p ***\n", [Seed]), Dog=?t:timetrap(?t:minutes(1)), diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index aa6cf2b881..33cb56c0b9 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1337,10 +1337,7 @@ unwanted_cixs() -> get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> - {A, B, C} = now(), - Atom = list_to_atom("atom" ++ integer_to_list(A*1000000000000 - + B*1000000 - + C)), + Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))), case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_atoms(CIX, N-1)]; @@ -1351,10 +1348,7 @@ get_conflicting_atoms(CIX, N) -> get_conflicting_unicode_atoms(_CIX, 0) -> []; get_conflicting_unicode_atoms(CIX, N) -> - {A, B, C} = now(), - Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(A*1000000000000 - + B*1000000 - + C)), + Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(erlang:unique_integer([positive]))), case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; @@ -1967,8 +1961,7 @@ dmsg_bad_atom_cache_ref() -> %%% Utilities timestamp() -> - {A,B,C} = erlang:now(), - (C div 1000) + (B * 1000) + (A * 1000000000). + erlang:monotonic_time(milli_seconds). start_node(X) -> start_node(X, [], []). @@ -1992,7 +1985,9 @@ start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) -> ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(timestamp()))), + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])))), start_node(Name, Args, Rel). stop_node(Node) -> @@ -2109,7 +2104,7 @@ node_monitor(Master) -> Master ! {nodeup, node(), Node} end, Nodes0), - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Nodes0]), + ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Nodes0]), node_monitor_loop(Master); false -> net_kernel:monitor_nodes(false, Opts), @@ -2130,7 +2125,7 @@ node_monitor_loop(Master) -> receive {nodeup, Node, _InfoList} = Msg -> Master ! {nodeup, node(), Node}, - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), + ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]), node_monitor_loop(Master); {nodedown, Node, InfoList} = Msg -> Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of @@ -2138,7 +2133,7 @@ node_monitor_loop(Master) -> _ -> undefined end, Master ! {nodedown, node(), Node, Reason}, - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), + ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]), node_monitor_loop(Master) end. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 623d62f876..e6beda1ccf 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -390,12 +390,12 @@ timer_measure(Config) when is_list(Config) -> try_timeouts(_, 0) -> ok; try_timeouts(Port, Timeout) -> - ?line TimeBefore = now(), + ?line TimeBefore = erlang:monotonic_time(), ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), receive {Port,{data,[?TIMER]}} -> ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), - io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed, Timeout]), if Elapsed < Timeout -> ?line ?t:fail(too_short); @@ -455,7 +455,7 @@ timer_delay(Config) when is_list(Config) -> Name = 'timer_drv', ?line Port = start_driver(Config, Name, false), - ?line TimeBefore = now(), + ?line TimeBefore = erlang:monotonic_time(), Timeout0 = 350, ?line erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>), Timeout = Timeout0 + @@ -499,7 +499,7 @@ timer_change(Config) when is_list(Config) -> try_change_timer(_Port, 0) -> ok; try_change_timer(Port, Timeout) -> ?line Timeout_3 = Timeout*3, - ?line TimeBefore = now(), + ?line TimeBefore = erlang:monotonic_time(), ?line erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>), ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), receive @@ -2520,13 +2520,11 @@ uniform(N) -> end, random:uniform(N). -%% return millisecs from statistics source erl_millisecs() -> - {Ms, S, Us} = erlang:now(), - Ms * 1000000000 + S * 1000 + Us / 1000. + erl_millisecs(erlang:monotonic_time()). -erl_millisecs({Ms,S,Us}) -> - Ms * 1000000000 + S * 1000 + Us / 1000. +erl_millisecs(MonotonicTime) -> + (1000*MonotonicTime)/erlang:convert_time_unit(1,seconds,native). %% Start/stop drivers. start_driver(Config, Name, Binary) -> @@ -2575,18 +2573,15 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 -> start_node(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> ?t:stop_node(Node). diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 435c0872e6..02c1d84d59 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1035,16 +1035,13 @@ get_names(N, T) when is_atom(T) -> get_names(0, _, Acc) -> Acc; get_names(N, T, Acc) -> - {A, B, C} = now(), get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(T) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]). start_node(Name) -> ?line start_node(Name, ""). diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index e5c904cfb9..bc5928436f 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -71,6 +71,11 @@ test_size(Config) when is_list(Config) -> 4 = do_test_size(#{}), 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,256)])) >= map_size_lower_bound(256), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,4096)])) >= map_size_lower_bound(4096), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,254)])) >= map_size_lower_bound(254), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,239)])) >= map_size_lower_bound(239), + %% Test internal consistency of sizes, but without testing %% exact sizes. Const = id(42), @@ -92,14 +97,14 @@ test_size(Config) when is_list(Config) -> %% Test shared data structures. do_test_size([ConsCell1|ConsCell1], - 3*ConsCellSz, - 2*ConsCellSz), + 3*ConsCellSz, + 2*ConsCellSz), do_test_size(fun() -> {ConsCell1,ConsCell2} end, - FunSz2 + 2*ConsCellSz, - FunSz2 + ConsCellSz), + FunSz2 + 2*ConsCellSz, + FunSz2 + ConsCellSz), do_test_size({SimplestFun,SimplestFun}, - 2*FunSz0+do_test_size({a,b}), - FunSz0+do_test_size({a,b})), + 2*FunSz0+do_test_size({a,b}), + FunSz0+do_test_size({a,b})), M = id(#{ "atom" => first, i => 0}), do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32), @@ -113,6 +118,13 @@ do_test_size(Term, FlatSz, Sz) -> FlatSz = erts_debug:flat_size(Term), Sz = erts_debug:size(Term). +map_size_lower_bound(N) -> + %% this est. is a bit lower that actual lower bound + %% number of internal nodes + T = (N - 1) div 15, + %% total words + 2 + 17 * T + 2 * N. + flat_size_big(Config) when is_list(Config) -> %% Build a term whose external size only fits in a big num (on 32-bit CPU). flat_size_big_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF). diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 1de6d6fb56..67a53d94b1 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -339,7 +339,6 @@ micros() -> ]. macro(Ms,DataDir) -> - erlang:now(), %% compensate for old 4.3 firsttime clock bug :-( statistics(reductions), statistics(runtime), lists(500), %% fixup cache on first round @@ -369,10 +368,9 @@ run_micro(Top, M, DataDir) -> apply_micro(M) -> {GC0, Words0, _} = statistics(garbage_collection), statistics(reductions), - Before = erlang:now(), - + Before = monotonic_time(), Compensate = apply_micro(M#micro.function, M#micro.loops), - After = erlang:now(), + After = monotonic_time(), {GC1, Words1, _} = statistics(garbage_collection), {_, Reds} = statistics(reductions), Elapsed = subtr(Before, After), @@ -389,12 +387,13 @@ apply_micro(M) -> {kilo_reductions, Reds div 1000}, {gc_intensity, gci(Elapsed, GC1 - GC0, Words1 - Words0)}]. +monotonic_time() -> + try erlang:monotonic_time() catch error:undef -> erlang:now() end. -subtr(Before, After) -> - (element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)). +subtr(Before, After) when is_integer(Before), is_integer(After) -> + erlang:convert_time_unit(After-Before, native, micro_seconds); +subtr({_,_,_}=Before, {_,_,_}=After) -> + timer:now_diff(After, Before). gci(Micros, Words, Gcs) -> ((256 * Gcs) / Micros) + (Words / Micros). @@ -633,10 +632,10 @@ tup_trav(T, P, End) -> %% Port I/O port_io(I) -> EstoneCat = get(estone_cat), - Before = erlang:now(), + Before = monotonic_time(), Pps = make_port_pids(5, I, EstoneCat), %% 5 ports send_procs(Pps, go), - After = erlang:now(), + After = monotonic_time(), wait_for_pids(Pps), subtr(Before, After). @@ -854,10 +853,10 @@ handle_call(_From, State, [abc]) -> %% Binary handling, creating, manipulating and sending binaries binary_h(I) -> - Before = erlang:now(), + Before = monotonic_time(), P = spawn(?MODULE, echo, [self()]), B = list_to_binary(lists:duplicate(2000, 5)), - After = erlang:now(), + After = monotonic_time(), Compensate = subtr(Before, After), binary_h_2(I, P, B), Compensate. diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 4a45afa9e9..a07516b5a9 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -294,16 +294,13 @@ id(I) -> I. start_node(Config) when is_list(Config) -> ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), ?line Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 36889b6c36..1b92e3198e 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -77,7 +77,7 @@ grow_heap1(List, MaxLen, CurLen, up) -> grow_heap1([], _MaxLen, _, down) -> ok; grow_heap1([_|List], MaxLen, CurLen, down) -> - {_,_,C} = erlang:now(), + C=erlang:unique_integer([positive]), Num = C rem (length(List))+1, Elem = lists:nth(Num, List), NewList = lists:delete(Elem, List), @@ -136,7 +136,7 @@ grow_stack_heap1(List, MaxLen, CurLen, up) -> grow_stack_heap1([], _MaxLen, _, down) -> ok; grow_stack_heap1([_|List], MaxLen, CurLen, down) -> grow_stack1(CurLen*2,0), - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Num=C rem (length(List))+1, Elem=lists:nth(Num, List), NewList=lists:delete(Elem, List), @@ -146,8 +146,8 @@ grow_stack_heap1([_|List], MaxLen, CurLen, down) -> %% Create an arbitrary element/term. make_arbit() -> - {AA,BB,CC}=erlang:now(), - A=AA+1, B=BB+1, C=CC+1, + {AA,BB,CC}=erlang:timestamp(), + A=AA+1, B=BB+1, C=(CC+erlang:unique_integer([positive])) rem 1000000 + 1, New = case C rem 9 of 0 -> make_string((B div C) +5); @@ -171,7 +171,7 @@ make_string(Length) -> make_string(_, 0, Acc) -> Acc; make_string(Alph, Length, Acc) -> - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Pos=1+(Length*C rem length(Alph)), make_string(Alph, Length-1, [lists:nth(Pos,Alph)|Acc]). diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 39549282c0..527b6987fa 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -1508,7 +1508,9 @@ t_map_equal(Config) when is_list(Config) -> t_map_compare(Config) when is_list(Config) -> - Seed = erlang:now(), + Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, io:format("seed = ~p\n", [Seed]), random:seed(Seed), repeat(100, fun(_) -> float_int_compare() end, []), diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index f3986f0c4f..1125cf3072 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -94,12 +94,15 @@ functions(Config) when is_list(Config) -> ok. %% Test that the list of exported functions from this module is correct. +%% Verify that module_info(native) works. native(Config) when is_list(Config) -> ?line All = all_functions(), ?line case ?MODULE:module_info(native_addresses) of [] -> + ?line false = ?MODULE:module_info(native), {comment,"no native functions"}; L -> + ?line true = ?MODULE:module_info(native), %% Verify that all functions have unique addresses. ?line S0 = sofs:set(L, [{name,arity,addr}]), ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0), diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index 07e2862b2a..dc215b1529 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -763,12 +763,10 @@ named_down(doc) -> ["Test that DOWN message for a named monitor isn't" " delivered until name has been unregistered"]; named_down(suite) -> []; named_down(Config) when is_list(Config) -> - ?line {A,B,C} = now(), ?line Name = list_to_atom(atom_to_list(?MODULE) ++ "-named_down-" - ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), ?line Prio = process_flag(priority,high), %% Spawn a bunch of high prio cpu bound processes to prevent %% normal prio processes from terminating during the next diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index a492501959..8dcd21f303 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -441,10 +441,10 @@ hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) -> receive after infinity -> ok end end) | Ps0] end, - Start = now(), + Start = erlang:monotonic_time(), lists:foreach(fun (P) -> P ! go end, Ps), lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps), - Stop = now(), + Stop = erlang:monotonic_time(), lists:foreach(fun (P) -> unlink(P), exit(P, bang), @@ -453,7 +453,7 @@ hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) -> {'DOWN', M, process, P, _} -> ok end end, Ps), - Res = timer:now_diff(Stop, Start)/1000000, + Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native), Caller ! {?MODULE, self(), Res} end, TP = spawn_link(T), diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 502ada95a1..c35c71dd5b 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1190,7 +1190,9 @@ send3(Config) when is_list(Config) -> %% Let a number of processes send random message blobs between each other %% using enif_send. Kill and spawn new ones randomly to keep a ~constant %% number of workers running. - Seed = now(), + Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, io:format("seed: ~p\n",[Seed]), random:seed(Seed), ets:new(nif_SUITE,[named_table,public]), diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 9c1839811a..2f505893b4 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -1120,26 +1120,18 @@ wait_until(Pred) -> false -> receive after 100 -> wait_until(Pred) end end. +get_nodefirstname_string() -> + atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])). get_nodefirstname() -> - {A, B, C} = now(), - list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)). + list_to_atom(get_nodefirstname_string()). get_nodename() -> - {A, B, C} = now(), - list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C) + list_to_atom(get_nodefirstname_string() ++ "@" ++ hostname()). diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index 262536a068..57f6928185 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -116,7 +116,7 @@ equal(Config) when is_list(Config) -> %% start controllers ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), ?line Starter = spawn(fun() -> starter(Normal, Low, Receiver) end), @@ -154,7 +154,7 @@ many_low(Config) when is_list(Config) -> Time = 30, ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), ?line Starter = spawn(fun() -> starter(Normal, Low, Receiver) end), ?line {NRs,NAvg,LRs,LAvg,Ratio} = @@ -185,7 +185,7 @@ few_low(Config) when is_list(Config) -> Time = 30, ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), ?line Starter = spawn(fun() -> starter(Normal, Low, Receiver) end), ?line {NRs,NAvg,LRs,LAvg,Ratio} = @@ -220,7 +220,7 @@ max(Config) when is_list(Config) -> Time = 30, ?line Receiver1 = - spawn(fun() -> receiver(now(), Time, Self, Max, High) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, High) end), ?line Starter1 = spawn(fun() -> starter(Max, High, Receiver1) end), ?line {M1Rs,M1Avg,HRs,HAvg,Ratio1} = @@ -238,7 +238,7 @@ max(Config) when is_list(Config) -> end, ?line Receiver2 = - spawn(fun() -> receiver(now(), Time, Self, Max, Normal) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Normal) end), ?line Starter2 = spawn(fun() -> starter(Max, Normal, Receiver2) end), ?line {M2Rs,M2Avg,NRs,NAvg,Ratio2} = @@ -256,7 +256,7 @@ max(Config) when is_list(Config) -> end, ?line Receiver3 = - spawn(fun() -> receiver(now(), Time, Self, Max, Low) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Low) end), ?line Starter3 = spawn(fun() -> starter(Max, Low, Receiver3) end), ?line {M3Rs,M3Avg,LRs,LAvg,Ratio3} = @@ -290,7 +290,7 @@ high(Config) when is_list(Config) -> Time = 30, ?line Receiver1 = - spawn(fun() -> receiver(now(), Time, Self, High, Normal) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Normal) end), ?line Starter1 = spawn(fun() -> starter(High, Normal, Receiver1) end), ?line {H1Rs,H1Avg,NRs,NAvg,Ratio1} = @@ -308,7 +308,7 @@ high(Config) when is_list(Config) -> end, ?line Receiver2 = - spawn(fun() -> receiver(now(), Time, Self, High, Low) end), + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Low) end), ?line Starter2 = spawn(fun() -> starter(High, Low, Receiver2) end), ?line {H2Rs,H2Avg,LRs,LAvg,Ratio2} = @@ -337,12 +337,13 @@ receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) -> %% uncomment lines below to get life sign (debug) receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) -> -% T = elapsed_ms(T0, now()), +% T = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, milli_seconds), % erlang:display({round(T/1000),P1Rs,P2Rs}), receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000); receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) -> - Remain = Time - elapsed_ms(T0, now()), % test time remaining + Remain = Time - erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, milli_seconds), % test time remaining Remain1 = if Remain < 0 -> 0; true -> @@ -409,6 +410,3 @@ flush_loop() -> ok end, flush_loop(). - -elapsed_ms({_MS0,S0,MuS0},{_MS1,S1,MuS1}) -> - round(((S1-S0)*1000)+((MuS1-MuS0)/1000)). diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 6bbf93b7d7..e61c330861 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1815,7 +1815,7 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> Parent = self(), ?t:format("SleepSecs = ~p~n", [SleepSecs]), PortProg = "sleep " ++ integer_to_list(SleepSecs), - Start = now(), + Start = erlang:monotonic_time(micro_seconds), NoProcs = case NoSchedsOnln of NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> NProcs; @@ -1887,12 +1887,12 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> receive {P, started, SIds} -> SIds end end, Procs), - StartedTime = timer:now_diff(now(), Start)/1000000, + StartedTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000, ?t:format("StartedTime = ~p~n", [StartedTime]), true = StartedTime < SleepSecs, erlang:system_flag(multi_scheduling, block), lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), - DoneTime = timer:now_diff(now(), Start)/1000000, + DoneTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000, ?t:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index bf31655066..105d39f126 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -379,16 +379,15 @@ eat_high(Low) -> process_flag(priority, high), receive after 1000 -> ok end, exit(Low, {you, are, dead}), - {_, Sec, _} = now(), - loop(Sec, Sec). + loop(erlang:monotonic_time() + erlang:convert_time_unit(5,seconds,native)). %% Busy loop for 5 seconds. -loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 -> - {_, NewSec, _} = now(), - loop(OrigSec, NewSec); -loop(_, _) -> - ok. +loop(StopTime) -> + case StopTime >= erlang:monotonic_time() of + true -> ok; + false -> loop(StopTime) + end. %% Tries to send two different exit messages to a process. @@ -2450,16 +2449,13 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3906471f87..c5af12c6d1 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1829,11 +1829,11 @@ do_it(Tracer, Low, Normal, High, Max) -> do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> OldPrio = process_flag(priority, max), go_work(Low, Normal, High, Max), - StartWait = now(), + StartWait = erlang:monotonic_time(milli_seconds), %% Give the emulator a chance to balance the load... wait_balance(5), - EndWait = now(), - BalanceWait = timer:now_diff(EndWait,StartWait) div 1000, + EndWait = erlang:monotonic_time(milli_seconds), + BalanceWait = EndWait-StartWait, erlang:display({balance_wait, BalanceWait}), Timeout = ?DEFAULT_TIMEOUT - ?t:minutes(4) - BalanceWait, Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of @@ -2027,17 +2027,14 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 736dfe5b56..dcb10c947e 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -515,12 +515,10 @@ repeat(Fun, N) when is_integer(N) -> repeat(Fun, N-1). start_node(Config) -> - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) - ++ "-" ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), + ++ "-" ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), Pa = filename:dirname(code:which(?MODULE)), ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]). diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 10b7e16a74..4c50b8ba8c 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -167,16 +167,13 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), Opts = [{args, "-pa "++Pa++" "++Args}], ?t:start_node(Name, slave, Opts). diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index f959714be7..e3ac2d5d83 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -264,6 +264,37 @@ memory_test(_Config) -> []), cmp_memory(MWs, "unlink procs"), + mem_workers_call(MWs, + fun () -> + lists:foreach( + fun (P) -> + Tmr = erlang:start_timer(1 bsl 34, + P, + hello), + Tmrs = case get('BIF_TMRS') of + undefined -> []; + Rs -> Rs + end, + true = is_reference(Tmr), + put('BIF_TMRS', [Tmr|Tmrs]) + end, Ps) + end, + []), + cmp_memory(MWs, "start BIF timer procs"), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (Tmr) -> + true = is_reference(Tmr), + true = is_integer(erlang:cancel_timer(Tmr)) + end, get('BIF_TMRS')), + put('BIF_TMRS', undefined), + garbage_collect() + end, + []), + erts_debug:set_internal_state(wait, deallocations), + cmp_memory(MWs, "cancel BIF timer procs"), + DMs = mem_workers_call(MWs, fun () -> lists:map(fun (P) -> @@ -533,16 +564,13 @@ get_ets_limit(Config, EtsMax) -> start_node(Config, Envs) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]). stop_node(Node) -> diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 43f7ac7f7c..d04a95b10e 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -18,6 +18,7 @@ %% -module(time_SUITE). +-compile({nowarn_deprecated_function, {erlang,now,0}}). %% "Time is on my side." -- The Rolling Stones @@ -37,6 +38,7 @@ now_unique/1, now_update/1, timestamp/1, time_warp_modes/1, monotonic_time_monotonicity/1, + monotonic_time_monotonicity_parallel/1, time_unit_conversion/1, signed_time_unit_conversion/1, erlang_timestamp/1]). @@ -79,6 +81,7 @@ all() -> {group, now}, timestamp, time_warp_modes, monotonic_time_monotonicity, + monotonic_time_monotonicity_parallel, time_unit_conversion, signed_time_unit_conversion, erlang_timestamp]. @@ -565,6 +568,78 @@ cmp_times(Done, X0) -> cmp_times(Done, X5) end. +-define(NR_OF_MONOTONIC_CALLS, 100000). + +monotonic_time_monotonicity_parallel(Config) when is_list(Config) -> + Me = self(), + Result = make_ref(), + Go = make_ref(), + UpAndRunning = make_ref(), + NoOnlnScheds = erlang:system_info(schedulers_online), + OffsetUI = erlang:unique_integer([monotonic]), + OffsetMT = erlang:monotonic_time(), + MinHSz = ?NR_OF_MONOTONIC_CALLS*(2 + + 3 + + erts_debug:flat_size(OffsetUI) + + erts_debug:flat_size(OffsetMT)), + Ps = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + Me ! {self(), UpAndRunning}, + receive Go -> ok end, + Res = fetch_monotonic(?NR_OF_MONOTONIC_CALLS, []), + Me ! {self(), Result, Sched, Res} + end, + [{scheduler, Sched}, + {priority, max}, + {min_heap_size, MinHSz}]) + end, + lists:seq(1, NoOnlnScheds)), + lists:foreach(fun (P) -> receive {P, UpAndRunning} -> ok end end, Ps), + lists:foreach(fun (P) -> P ! Go end, Ps), + TMs = recv_monotonics(Result, OffsetMT, OffsetUI, NoOnlnScheds, []), + true = check_monotonic_result(TMs, OffsetMT, OffsetUI, true). + +check_monotonic_result([{_Sched, _PrevUI, _MT, _PostUI}], + _OffsetMT, _OffsetUI, Res) -> + Res; +check_monotonic_result([{_ASched, _APrevUI, AMT, APostUI} = A, + {_BSched, BPrevUI, BMT, _BPostUI} = B | _] = L, + OffsetMT, OffsetUI, Res) -> + NewRes = case (AMT =< BMT) orelse (BPrevUI < APostUI) of + true -> + Res; + false -> + io:format("INCONSISTENCY: ~p ~p~n", [A, B]), + false + end, + check_monotonic_result(tl(L), OffsetMT, OffsetUI, NewRes). + +recv_monotonics(_Result, _OffsetMT, _OffsetUI, 0, Acc) -> + lists:keysort(2, Acc); +recv_monotonics(Result, OffsetMT, OffsetUI, N, Acc) -> + receive + {_, Result, Sched, Res} -> + CRes = convert_monotonic(Sched, OffsetMT, OffsetUI, Res, []), + recv_monotonics(Result, OffsetMT, OffsetUI, N-1, CRes ++ Acc) + end. + +convert_monotonic(_Sched, _OffsetMT, _OffsetUI, [{_MT, _UI}], Acc) -> + Acc; +convert_monotonic(Sched, OffsetMT, OffsetUI, + [{MT, UI}, {_PrevMT, PrevUI} | _] = L, Acc) -> + convert_monotonic(Sched, OffsetMT, OffsetUI, tl(L), + [{Sched, PrevUI-OffsetUI, MT-OffsetMT, UI-OffsetUI} + | Acc]). + +fetch_monotonic(0, Acc) -> + Acc; +fetch_monotonic(N, Acc) -> + MT = erlang:monotonic_time(), + UI = erlang:unique_integer([monotonic]), + fetch_monotonic(N-1, [{MT, UI} | Acc]). + -define(CHK_RES_CONVS_TIMEOUT, 400). time_unit_conversion(Config) when is_list(Config) -> diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index 56a1cef761..d406456f98 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -26,11 +26,17 @@ cancel_timer_1/1, start_timer_big/1, send_after_big/1, start_timer_e/1, send_after_e/1, cancel_timer_e/1, - read_timer_trivial/1, read_timer/1, - cleanup/1, evil_timers/1, registered_process/1]). + read_timer_trivial/1, read_timer/1, read_timer_async/1, + cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1, + same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1, + same_time_yielding_with_cancel_other_accessor/1, auto_cancel_yielding/1]). -include_lib("test_server/include/test_server.hrl"). +-define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated +-define(TIMEOUT_YIELD_LIMIT, 100). +-define(AUTO_CANCEL_YIELD_LIMIT, 100). + init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:seconds(30)), case catch erts_debug:get_internal_state(available_internal_state) of @@ -45,6 +51,7 @@ end_per_testcase(_Case, Config) -> ok. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> @@ -56,8 +63,12 @@ all() -> [start_timer_1, send_after_1, send_after_2, cancel_timer_1, start_timer_e, send_after_e, cancel_timer_e, start_timer_big, send_after_big, - read_timer_trivial, read_timer, cleanup, evil_timers, - registered_process]. + read_timer_trivial, read_timer, read_timer_async, + cleanup, evil_timers, registered_process, + same_time_yielding, same_time_yielding_with_cancel, + same_time_yielding_with_cancel_other, + same_time_yielding_with_cancel_other_accessor, + auto_cancel_yielding]. groups() -> []. @@ -162,7 +173,7 @@ cancel_timer_1(Config) when is_list(Config) -> start_timer_e(doc) -> ["Error cases for start_timer/3"]; start_timer_e(Config) when is_list(Config) -> ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(4728472847827482, + ?line {'EXIT', _} = (catch erlang:start_timer(1 bsl 64, self(), hej)), ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), @@ -180,7 +191,7 @@ send_after_e(doc) -> ["Error cases for send_after/3"]; send_after_e(suite) -> []; send_after_e(Config) when is_list(Config) -> ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(4728472847827482, + ?line {'EXIT', _} = (catch erlang:send_after(1 bsl 64, self(), hej)), ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), @@ -213,44 +224,79 @@ read_timer_trivial(Config) when is_list(Config) -> read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; read_timer(suite) -> []; read_timer(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:send_after(Big, self(), hej_hopp), + process_flag(scheduler, 1), + Big = 1 bsl 31, + R = erlang:send_after(Big, self(), hej_hopp), + + receive after 200 -> ok end, % Delay and clear reductions. + Left = erlang:read_timer(R), + Left2 = erlang:cancel_timer(R), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + false = erlang:read_timer(R), - ?line receive after 200 -> ok end, % Delay and clear reductions. - ?line Left = erlang:read_timer(R), - ?line Left = erlang:cancel_timer(R), - ?line false = erlang:read_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), + ok. - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, +read_timer_async(doc) -> ["Test that read_timer/1 seems to return the correct values."]; +read_timer_async(suite) -> []; +read_timer_async(Config) when is_list(Config) -> + process_flag(scheduler, 1), + Big = 1 bsl 33, + R = erlang:send_after(Big, self(), hej_hopp), + + %% Access from another scheduler + process_flag(scheduler, erlang:system_info(schedulers_online)), + + receive after 200 -> ok end, % Delay and clear reductions. + ok = erlang:read_timer(R, [{async, true}]), + ok = erlang:cancel_timer(R, [{async, true}, {info, true}]), + ok = erlang:read_timer(R, [{async, true}]), + + {read_timer, R, Left} = receive_one(), + {cancel_timer, R, Left2} = receive_one(), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + {read_timer, R, false} = receive_one(), + + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), ok. cleanup(doc) -> []; cleanup(suite) -> []; cleanup(Config) when is_list(Config) -> - {skipped, "Test needs to be UPDATED for new timer implementation"}. - -cleanup_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Timer on dead process ?line P1 = spawn(fun () -> ok end), ?line wait_until(fun () -> process_is_cleaned_up(P1) end), - ?line T1 = erlang:start_timer(10000, P1, "hej"), - ?line T2 = erlang:send_after(10000, P1, "hej"), + ?line T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"), + ?line T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"), receive after 1000 -> ok end, ?line Mem = mem(), ?line false = erlang:read_timer(T1), ?line false = erlang:read_timer(T2), ?line Mem = mem(), %% Process dies before timeout - ?line P2 = spawn(fun () -> receive after 500 -> ok end end), - ?line T3 = erlang:start_timer(10000, P2, "hej"), - ?line T4 = erlang:send_after(10000, P2, "hej"), - ?line true = Mem < mem(), + ?line P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end), + ?line T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"), + ?line T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T3)), ?line true = is_integer(erlang:read_timer(T4)), ?line wait_until(fun () -> process_is_cleaned_up(P2) end), @@ -259,21 +305,22 @@ cleanup_test(Config) when is_list(Config) -> ?line false = erlang:read_timer(T4), ?line Mem = mem(), %% Cancel timer - ?line P3 = spawn(fun () -> receive after 20000 -> ok end end), - ?line T5 = erlang:start_timer(10000, P3, "hej"), - ?line T6 = erlang:send_after(10000, P3, "hej"), - ?line true = Mem < mem(), + ?line P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end), + ?line T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"), + ?line T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:cancel_timer(T5)), ?line true = is_integer(erlang:cancel_timer(T6)), ?line false = erlang:read_timer(T5), ?line false = erlang:read_timer(T6), ?line exit(P3, kill), + ?line wait_until(fun () -> process_is_cleaned_up(P3) end), ?line Mem = mem(), %% Timeout ?line Ref = make_ref(), - ?line T7 = erlang:start_timer(500, self(), Ref), - ?line T8 = erlang:send_after(500, self(), Ref), - ?line true = Mem < mem(), + ?line T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref), + ?line T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T7)), ?line true = is_integer(erlang:read_timer(T8)), ?line receive {timeout, T7, Ref} -> ok end, @@ -423,15 +470,12 @@ evil_recv_timeouts(TOs, N, M) -> registered_process(doc) -> []; registered_process(suite) -> []; registered_process(Config) when is_list(Config) -> - {skipped, "Test needs to be UPDATED for new timer implementation"}. - -registered_process_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Cancel - ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), - ?line T2 = erlang:send_after(500, ?MODULE, "hej"), + ?line T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + ?line T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"), ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:cancel_timer(T1)), ?line true = is_integer(erlang:cancel_timer(T2)), ?line false = erlang:read_timer(T1), @@ -439,10 +483,10 @@ registered_process_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Timeout register after start ?line Ref1 = make_ref(), - ?line T3 = erlang:start_timer(500, ?MODULE, Ref1), - ?line T4 = erlang:send_after(500, ?MODULE, Ref1), + ?line T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + ?line T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1), ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T3)), ?line true = is_integer(erlang:read_timer(T4)), ?line true = register(?MODULE, self()), @@ -451,9 +495,9 @@ registered_process_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Timeout register before start ?line Ref2 = make_ref(), - ?line T5 = erlang:start_timer(500, ?MODULE, Ref2), - ?line T6 = erlang:send_after(500, ?MODULE, Ref2), - ?line true = Mem < mem(), + ?line T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + ?line T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T5)), ?line true = is_integer(erlang:read_timer(T6)), ?line receive {timeout, T5, Ref2} -> ok end, @@ -462,19 +506,135 @@ registered_process_test(Config) when is_list(Config) -> ?line true = unregister(?MODULE), ?line ok. -mem() -> - TSrvs = erts_internal:get_bif_timer_servers(), - lists:foldl(fun (Tab, Sz) -> - case lists:member(ets:info(Tab, owner), TSrvs) of - true -> - ets:info(Tab, memory) + Sz; - false -> - Sz - end - end, - 0, - ets:all())*erlang:system_info({wordsize,external}). - +same_time_yielding(Config) when is_list(Config) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(milli_seconds) + 3000, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), hej, [{abs, true}]) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + lists:foreach(fun (Tmr) -> receive {timeout, Tmr, hej} -> ok end end, Tmrs), + Done = erlang:monotonic_time(milli_seconds), + true = Done >= Tmo, + case erlang:system_info(build_type) of + opt -> true = Done < Tmo + 200; + _ -> true = Done < Tmo + 1000 + end, + Mem = mem(), + ok. + +same_time_yielding_with_cancel(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(false, false). + +same_time_yielding_with_cancel_other(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(true, false). + +same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(true, true). + +do_cancel_tmrs(Tmo, Tmrs, Tester) -> + BeginCancel = erlang:convert_time_unit(Tmo, + milli_seconds, + micro_seconds) - 100, + busy_wait_until(fun () -> + erlang:monotonic_time(micro_seconds) >= BeginCancel + end), + lists:foreach(fun (Tmr) -> + erlang:cancel_timer(Tmr, + [{async, true}, + {info, true}]) + end, Tmrs), + case Tester == self() of + true -> ok; + false -> forward_msgs(Tester) + end. + +same_time_yielding_with_cancel_test(Other, Accessor) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(milli_seconds) + 3000, + Tester = self(), + Cancelor = case Other of + false -> + Tester; + true -> + spawn(fun () -> + receive + {timers, Tmrs} -> + do_cancel_tmrs(Tmo, Tmrs, Tester) + end + end) + end, + Opts = case Accessor of + false -> [{abs, true}]; + true -> [{accessor, Cancelor}, {abs, true}] + end, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), hej, Opts) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + case Other of + false -> + do_cancel_tmrs(Tmo, Tmrs, Tester); + true -> + Cancelor ! {timers, Tmrs} + end, + {Tmos, Cncls} = lists:foldl(fun (Tmr, {T, C}) -> + receive + {timeout, Tmr, hej} -> + receive + {cancel_timer, Tmr, Info} -> + false = Info, + {T+1, C} + end; + {cancel_timer, Tmr, false} -> + receive + {timeout, Tmr, hej} -> + {T+1, C} + end; + {cancel_timer, Tmr, TimeLeft} -> + true = is_integer(TimeLeft), + {T, C+1} + end + end, + {0, 0}, + Tmrs), + io:format("Timeouts: ~p Cancels: ~p~n", [Tmos, Cncls]), + Mem = mem(), + case Other of + true -> exit(Cancelor, bang); + false -> ok + end, + {comment, + "Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: " + ++ integer_to_list(Cncls)}. + +auto_cancel_yielding(Config) when is_list(Config) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + P = spawn(fun () -> + lists:foreach( + fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln)+1), + erlang:start_timer((1 bsl 28)+I*10, self(), hej) + end, + lists:seq(1, + ((?AUTO_CANCEL_YIELD_LIMIT*3+1) + *SchdlrsOnln))), + receive after infinity -> ok end + end), + true = mem_larger_than(Mem), + exit(P, bang), + wait_until(fun () -> process_is_cleaned_up(P) end), + receive after 1000 -> ok end, + Mem = mem(), + ok. + process_is_cleaned_up(P) when is_pid(P) -> undefined == erts_debug:get_internal_state({process_status, P}). @@ -484,6 +644,19 @@ wait_until(Pred) when is_function(Pred) -> _ -> receive after 50 -> ok end, wait_until(Pred) end. +busy_wait_until(Pred) when is_function(Pred) -> + case catch Pred() of + true -> ok; + _ -> busy_wait_until(Pred) + end. + +forward_msgs(To) -> + receive + Msg -> + To ! Msg + end, + forward_msgs(To). + get(Time, Msg) -> receive Msg -> @@ -502,9 +675,10 @@ get_msg() -> end. start_slave() -> - ?line {A, B, C} = now(), ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C), + ?line Name = atom_to_list(?MODULE) + ++ "-" ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive])), {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]), Node. @@ -565,5 +739,58 @@ type(X) when is_port(X) -> {port, node(X)}; type(X) when is_binary(X) -> binary; type(X) when is_atom(X) -> atom; type(_) -> unknown. - + +mem_larger_than(no_fix_alloc) -> + true; +mem_larger_than(Mem) -> + mem() > Mem. + +mem() -> + erts_debug:set_internal_state(wait, deallocations), + erts_debug:set_internal_state(wait, deallocations), + case mem_get() of + {-1, -1} -> no_fix_alloc; + {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U + end. + +mem_get() -> + % Bif timer memory + Ref = make_ref(), + erlang:system_info({memory_internal, Ref, [fix_alloc]}), + mem_recv(erlang:system_info(schedulers), Ref, {0, 0}). + +mem_recv(0, _Ref, AU) -> + AU; +mem_recv(N, Ref, AU) -> + receive + {Ref, _, IL} -> + mem_recv(N-1, Ref, mem_parse_ilists(IL, AU)) + end. + + +mem_parse_ilists([], AU) -> + AU; +mem_parse_ilists([I|Is], AU) -> + mem_parse_ilists(Is, mem_parse_ilist(I, AU)). + +mem_parse_ilist({fix_alloc, false}, _) -> + {-1, -1}; +mem_parse_ilist({fix_alloc, _, IDL}, {A, U}) -> + case lists:keyfind(fix_types, 1, IDL) of + {fix_types, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {ThisA + A, ThisU + U}; + {fix_types, Mask, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {(ThisA + A) band Mask , (ThisU + U) band Mask} + end. + +mem_get_btm_aus([], A, U) -> + {A, U}; +mem_get_btm_aus([{BtmType, BtmA, BtmU} | Types], + A, U) when BtmType == bif_timer; + BtmType == accessor_bif_timer -> + mem_get_btm_aus(Types, BtmA+A, BtmU+U); +mem_get_btm_aus([_|Types], A, U) -> + mem_get_btm_aus(Types, A, U). diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 3036d2957b..9c444ed682 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -326,10 +326,10 @@ combo(Config) when is_list(Config) -> %% ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), - ?line T0 = now(), + ?line T0 = erlang:monotonic_time(), ?line with_bif(Nbc), - ?line T1 = now(), - ?line TimeB = timer:now_diff(T1,T0), + ?line T1 = erlang:monotonic_time(), + ?line TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds), %% ?line List = collect(100), @@ -695,17 +695,17 @@ setup(Opts) -> Pid. execute(Pids, Mfa) when is_list(Pids) -> - T0 = now(), + T0 = erlang:monotonic_time(), [P ! {self(), execute, Mfa} || P <- Pids], As = [receive {P, answer, Answer} -> Answer end || P <- Pids], - T1 = now(), - {As, timer:now_diff(T1,T0)}; + T1 = erlang:monotonic_time(), + {As, erlang:convert_time_unit(T1-T0, native, micro_seconds)}; execute(P, Mfa) -> - T0 = now(), + T0 = erlang:monotonic_time(), P ! {self(), execute, Mfa}, A = receive {P, answer, Answer} -> Answer end, - T1 = now(), - {A, timer:now_diff(T1,T0)}. + T1 = erlang:monotonic_time(), + {A, erlang:convert_time_unit(T1-T0, native, micro_seconds)}. diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex df768f9ed6..df12c6f8e0 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 3478a80dd4..c0fca6aafa 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 9ed45b34bf..0e0811af3f 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 7361139cde..851513b2e9 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 4af9d233b5..33c112f4de 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 7c0b49235e..ebca6e7eea 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 00babefbb4..e8817d183e 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 6640a29c62..6729f06b79 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 3d6f1548d0..969239be98 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 3224546179..281f668f8c 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index fd11c101bc..ea8a911a2c 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -129,10 +129,11 @@ -export([process_display/2]). -export([process_flag/3, process_info/1, processes/0, purge_module/1]). -export([put/2, raise/3, read_timer/1, read_timer/2, ref_to_list/1, register/2]). --export([registered/0, resume_process/1, round/1, self/0, send_after/3]). +-export([send_after/3, send_after/4, start_timer/3, start_timer/4]). +-export([registered/0, resume_process/1, round/1, self/0]). -export([seq_trace/2, seq_trace_print/1, seq_trace_print/2, setnode/2]). -export([setnode/3, size/1, spawn/3, spawn_link/3, split_binary/2]). --export([start_timer/3, suspend_process/2, system_monitor/0]). +-export([suspend_process/2, system_monitor/0]). -export([system_monitor/1, system_monitor/2, system_profile/0]). -export([system_profile/2, throw/1, time/0, trace/3, trace_delivered/1]). -export([trace_info/2, trunc/1, tuple_size/1, universaltime/0]). @@ -424,80 +425,26 @@ call_on_load_function(_P1) -> erlang:nif_error(undefined). %% cancel_timer/1 --spec erlang:cancel_timer(TimerRef) -> Time | false when +-spec erlang:cancel_timer(TimerRef) -> Result when TimerRef :: reference(), - Time :: non_neg_integer(). -cancel_timer(TimerRef) -> - try - case erts_internal:access_bif_timer(TimerRef) of - undefined -> - false; - {BTR, TSrv} -> - Req = erlang:make_ref(), - TSrv ! {cancel_timeout, BTR, erlang:self(), - true, Req, TimerRef}, - receive - {cancel_timer, Req, Result} -> - Result - end - end - catch - _:_ -> erlang:error(badarg, [TimerRef]) - end. + Time :: non_neg_integer(), + Result :: Time | false. + +cancel_timer(_TimerRef) -> + erlang:nif_error(undefined). %% cancel_timer/2 --spec erlang:cancel_timer(TimerRef, Options) -> Time | false | ok when +-spec erlang:cancel_timer(TimerRef, Options) -> Result | ok when TimerRef :: reference(), - Option :: {async, boolean()} | {info, boolean()}, + Async :: boolean(), + Info :: boolean(), + Option :: {async, Async} | {info, Info}, Options :: [Option], - Time :: non_neg_integer(). -cancel_timer(TimerRef, Options) -> - try - {Async, Info} = get_cancel_timer_options(Options, false, true), - case erts_internal:access_bif_timer(TimerRef) of - undefined -> - case {Async, Info} of - {true, true} -> - erlang:self() ! {cancel_timer, TimerRef, false}, ok; - {false, true} -> - false; - _ -> - ok - end; - {BTR, TSrv} -> - case Async of - true -> - TSrv ! {cancel_timeout, BTR, erlang:self(), - Info, TimerRef, TimerRef}, - ok; - false -> - Req = erlang:make_ref(), - TSrv ! {cancel_timeout, BTR, erlang:self(), - true, Req, TimerRef}, - receive - {cancel_timer, Req, Result} -> - case Info of - true -> Result; - false -> ok - end - end - end - end - catch - _:_ -> erlang:error(badarg, [TimerRef, Options]) - end. + Time :: non_neg_integer(), + Result :: Time | false. -get_cancel_timer_options([], Async, Info) -> - {Async, Info}; -get_cancel_timer_options([{async, Bool} | Opts], - _Async, Info) when Bool == true; - Bool == false -> - get_cancel_timer_options(Opts, Bool, Info); -get_cancel_timer_options([{info, Bool} | Opts], - Async, _Info) when Bool == true; - Bool == false -> - get_cancel_timer_options(Opts, Async, Bool). - +cancel_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). %% check_old_code/1 -spec check_old_code(Module) -> boolean() when @@ -1535,55 +1482,25 @@ raise(_Class, _Reason, _Stacktrace) -> erlang:nif_error(undefined). %% read_timer/1 --spec erlang:read_timer(TimerRef) -> non_neg_integer() | false when - TimerRef :: reference(). +-spec erlang:read_timer(TimerRef) -> Result when + TimerRef :: reference(), + Time :: non_neg_integer(), + Result :: Time | false. -read_timer(TimerRef) -> - read_timer(TimerRef, []). +read_timer(_TimerRef) -> + erlang:nif_error(undefined). %% read_timer/2 --spec erlang:read_timer(TimerRef, Options) -> non_neg_integer() | false | ok when +-spec erlang:read_timer(TimerRef, Options) -> Result | ok when TimerRef :: reference(), - Option :: {async, boolean()}, - Options :: [Option]. - -read_timer(TimerRef, Options) -> - try - Async = get_read_timer_options(Options, false), - case erts_internal:access_bif_timer(TimerRef) of - undefined -> - case Async of - true -> - erlang:self() ! {read_timer, TimerRef, false}, - ok; - false -> - false - end; - {BTR, TSrv} -> - case Async of - true -> - TSrv ! {read_timeout, BTR, erlang:self(), - TimerRef, TimerRef}, - ok; - false -> - Req = erlang:make_ref(), - TSrv ! {read_timeout, BTR, erlang:self(), - Req, TimerRef}, - receive - {read_timer, Req, Result} -> - Result - end - end - end - catch - _:_ -> erlang:error(badarg, [TimerRef]) - end. + Async :: boolean(), + Option :: {async, Async}, + Options :: [Option], + Time :: non_neg_integer(), + Result :: Time | false. -get_read_timer_options([], Async) -> - Async; -get_read_timer_options([{async, Bool} | Opts], - _Async) when Bool == true; Bool == false -> - get_read_timer_options(Opts, Bool). +read_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). %% ref_to_list/1 -spec erlang:ref_to_list(Ref) -> string() when @@ -1630,35 +1547,21 @@ self() -> Msg :: term(), TimerRef :: reference(). -send_after(0, Dest, Msg) -> - try - true = ((erlang:is_pid(Dest) - andalso erlang:node(Dest) == erlang:node()) - orelse (erlang:is_atom(Dest) - andalso Dest /= undefined)), - try Dest ! Msg catch _:_ -> ok end, - erlang:make_ref() - catch - _:_ -> - erlang:error(badarg, [0, Dest, Msg]) - end; -send_after(Time, Dest, Msg) -> - Now = erlang:monotonic_time(), - try - true = ((erlang:is_pid(Dest) - andalso erlang:node(Dest) == erlang:node()) - orelse (erlang:is_atom(Dest) - andalso Dest /= undefined)), - true = Time > 0, - true = Time < (1 bsl 32), % Maybe lift this restriction... - TO = Now + (erts_internal:time_unit()*Time) div 1000, - {BTR, TSrv, TRef} = erts_internal:create_bif_timer(), - TSrv ! {set_timeout, BTR, Dest, TO, TRef, Msg}, - TRef - catch - _:_ -> - erlang:error(badarg, [Time, Dest, Msg]) - end. +send_after(_Time, _Dest, _Msg) -> + erlang:nif_error(undefined). + +%% send_after/4 +-spec erlang:send_after(Time, Dest, Msg, Options) -> TimerRef when + Time :: integer(), + Dest :: pid() | atom(), + Msg :: term(), + Options :: [Option], + Abs :: boolean(), + Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + TimerRef :: reference(). + +send_after(_Time, _Dest, _Msg, _Options) -> + erlang:nif_error(undefined). %% seq_trace/2 -spec erlang:seq_trace(P1, P2) -> seq_trace_info_returns() | {term(), term(), term(), term(), term()} when @@ -1731,37 +1634,22 @@ split_binary(_Bin, _Pos) -> Dest :: pid() | atom(), Msg :: term(), TimerRef :: reference(). -start_timer(0, Dest, Msg) -> - try - true = ((erlang:is_pid(Dest) - andalso erlang:node(Dest) == erlang:node()) - orelse (erlang:is_atom(Dest) - andalso Dest /= undefined)), - TimerRef = erlang:make_ref(), - _ = try Dest ! {timeout, TimerRef, Msg} catch _:_ -> ok end, - TimerRef - catch - _:_ -> - erlang:error(badarg, [0, Dest, Msg]) - end; -start_timer(Time, Dest, Msg) -> - Now = erlang:monotonic_time(), - try - true = ((erlang:is_pid(Dest) - andalso erlang:node(Dest) == erlang:node()) - orelse (erlang:is_atom(Dest) - andalso Dest /= undefined)), - true = Time > 0, - true = Time < (1 bsl 32), % Maybe lift this restriction... - TO = Now + (erts_internal:time_unit()*Time) div 1000, - {BTR, TSrv, TimerRef} = erts_internal:create_bif_timer(), - TSrv ! {set_timeout, BTR, Dest, TO, TimerRef, - {timeout, TimerRef, Msg}}, - TimerRef - catch - _:_ -> - erlang:error(badarg, [Time, Dest, Msg]) - end. + +start_timer(_Time, _Dest, _Msg) -> + erlang:nif_error(undefined). + +%% start_timer/4 +-spec erlang:start_timer(Time, Dest, Msg, Options) -> TimerRef when + Time :: integer(), + Dest :: pid() | atom(), + Msg :: term(), + Options :: [Option], + Abs :: boolean(), + Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + TimerRef :: reference(). + +start_timer(_Time, _Dest, _Msg, _Options) -> + erlang:nif_error(undefined). %% suspend_process/2 -spec erlang:suspend_process(Suspendee, OptList) -> boolean() when @@ -1931,7 +1819,7 @@ element(_N, _Tuple) -> %% Not documented -spec erlang:get_module_info(Module, Item) -> ModuleInfo when Module :: atom(), - Item :: module | imports | exports | functions | attributes | compile | native_addresses | md5, + Item :: module | exports | functions | attributes | compile | native_addresses | md5, ModuleInfo :: atom() | [] | [{atom(), arity()}] | [{atom(), term()}] | [{atom(), arity(), integer()}]. get_module_info(_Module, _Item) -> erlang:nif_error(undefined). @@ -3712,7 +3600,11 @@ blocks_size([], Acc) -> get_fix_proc([{ProcType, A1, U1}| Rest], {A0, U0}) when ProcType == proc; ProcType == monitor_sh; ProcType == nlink_sh; - ProcType == msg_ref -> + ProcType == msg_ref; + ProcType == ll_ptimer; + ProcType == hl_ptimer; + ProcType == bif_timer; + ProcType == accessor_bif_timer -> get_fix_proc(Rest, {A0+A1, U0+U1}); get_fix_proc([_|Rest], Acc) -> get_fix_proc(Rest, Acc); diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index e489001532..65a1f1ed3a 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -40,13 +40,9 @@ -export([flush_monitor_messages/3]). --export([time_unit/0]). - --export([bif_timer_server/2]). - --export([get_bif_timer_servers/0, create_bif_timer/0, access_bif_timer/1]). +-export([await_result/1]). --export([monitor_process/2]). +-export([time_unit/0]). -export([is_system_process/1]). @@ -61,6 +57,16 @@ await_port_send_result(Ref, Busy, Ok) -> end. %% +%% Await result... +%% + +await_result(Ref) when is_reference(Ref) -> + receive + {Ref, Result} -> + Result + end. + +%% %% Statically linked port NIFs %% @@ -234,245 +240,8 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) -> time_unit() -> erlang:nif_error(undefined). --spec erts_internal:get_bif_timer_servers() -> Pids when - Pid :: pid(), - Pids :: [Pid]. - -get_bif_timer_servers() -> - erlang:nif_error(undefined). - --spec erts_internal:create_bif_timer() -> Res when - Res :: {reference(), pid(), reference()}. - -create_bif_timer() -> - erlang:nif_error(undefined). - --spec erts_internal:access_bif_timer(Ref) -> Res when - Ref :: reference(), - Res :: {reference(), pid()} | 'undefined'. - -access_bif_timer(_Ref) -> - erlang:nif_error(undefined). - --spec erts_internal:monitor_process(Pid, Ref) -> boolean() when - Pid :: pid(), - Ref :: reference(). - -monitor_process(_Pid, _Ref) -> - erlang:nif_error(undefined). - -spec erts_internal:is_system_process(Pid) -> boolean() when Pid :: pid(). is_system_process(_Pid) -> erlang:nif_error(undefined). - -%% -%% BIF timer servers -%% - --record(tsrv_state, {rtab, - ttab, - btr, - unit, - next}). - -bif_timer_server(N, BTR) -> - try - tsrv_loop(tsrv_init_static_state(N, BTR), infinity) - catch - Type:Reason -> - erlang:display({'BIF_timer_server', - {Type, Reason}, - erlang:get_stacktrace()}), - exit(Reason) - end. - -tsrv_init_static_state(N, BTR) -> - process_flag(trap_exit, true), - NList = integer_to_list(N), - RTabName = list_to_atom("BIF_timer_reference_table_" ++ NList), - TTabName = list_to_atom("BIF_timer_time_table_" ++ NList), - #tsrv_state{rtab = ets:new(RTabName, - [set, private, {keypos, 2}]), - ttab = ets:new(TTabName, - [ordered_set, private, {keypos, 1}]), - btr = BTR, - unit = erts_internal:time_unit(), - next = infinity}. - - -tsrv_loop(#tsrv_state{unit = Unit} = StaticState, Nxt) -> - CallTime = erlang:monotonic_time(), - %% 'infinity' is greater than all integers... - NewNxt = case CallTime >= Nxt of - true -> - tsrv_handle_timeout(CallTime, StaticState); - false -> - TMO = try - (1000*(Nxt - CallTime - 1)) div Unit + 1 - catch - error:badarith when Nxt == infinity -> infinity - end, - receive - Msg -> - tsrv_handle_msg(Msg, StaticState, Nxt) - after TMO -> - Nxt - end - end, - tsrv_loop(StaticState, NewNxt). - -tsrv_handle_msg({set_timeout, BTR, Proc, Time, TRef, Msg}, - #tsrv_state{rtab = RTab, - ttab = TTab, - btr = BTR}, - Nxt) when erlang:is_integer(Time) -> - RcvTime = erlang:monotonic_time(), - case Time =< RcvTime of - true -> - try Proc ! Msg catch _:_ -> ok end, - Nxt; - false -> - Ins = case erlang:is_atom(Proc) of - true -> - true; - false -> - try - erts_internal:monitor_process(Proc, TRef) - catch - _:_ -> false - end - end, - case Ins of - false -> - Nxt; - true -> - TKey = {Time, TRef}, - true = ets:insert(RTab, TKey), - true = ets:insert(TTab, {TKey, Proc, Msg}), - case Time < Nxt of - true -> Time; - false -> Nxt - end - end - end; -tsrv_handle_msg({cancel_timeout, BTR, From, Reply, Req, TRef}, - #tsrv_state{rtab = RTab, - ttab = TTab, - unit = Unit, - btr = BTR}, - Nxt) -> - case ets:lookup(RTab, TRef) of - [] -> - case Reply of - false -> - ok; - _ -> - _ = try From ! {cancel_timer, Req, false} catch _:_ -> ok end - end, - Nxt; - [{Time, TRef} = TKey] -> - ets:delete(RTab, TRef), - ets:delete(TTab, TKey), - erlang:demonitor(TRef), - case Reply of - false -> - ok; - _ -> - RcvTime = erlang:monotonic_time(), - RT = case Time =< RcvTime of - true -> - 0; - false -> - ((1000*(Time - RcvTime)) div Unit) - end, - _ = try From ! {cancel_timer, Req, RT} catch _:_ -> ok end - end, - case Time =:= Nxt of - false -> - Nxt; - true -> - case ets:first(TTab) of - '$end_of_table' -> infinity; - {NextTime, _TRef} -> NextTime - end - end - end; -tsrv_handle_msg({read_timeout, BTR, From, Req, TRef}, - #tsrv_state{rtab = RTab, - unit = Unit, - btr = BTR}, - Nxt) -> - case ets:lookup(RTab, TRef) of - [] -> - _ = try From ! {read_timer, Req, false} catch _:_ -> ok end; - [{Time, TRef}] -> - RcvTime = erlang:monotonic_time(), - RT = case Time =< RcvTime of - true -> 0; - false -> (1000*(Time - RcvTime)) div Unit - end, - _ = try From ! {read_timer, Req, RT} catch _:_ -> ok end - end, - Nxt; -tsrv_handle_msg({'DOWN', TRef, process, _, _}, - #tsrv_state{rtab = RTab, - ttab = TTab}, - Nxt) -> - case ets:lookup(RTab, TRef) of - [] -> - Nxt; - [{Time, TRef} = TKey] -> - ets:delete(RTab, TRef), - ets:delete(TTab, TKey), - case Time =:= Nxt of - false -> - Nxt; - true -> - case ets:first(TTab) of - '$end_of_table' -> infinity; - {NextTime, _} -> NextTime - end - end - end; -tsrv_handle_msg({cancel_all_timeouts, BTR, From, Ref}, - #tsrv_state{rtab = RTab, - ttab = TTab, - btr = BTR}, - _Nxt) -> - tsrv_delete_monitor_objects(RTab), - ets:delete_all_objects(TTab), - try From ! {canceled_all_timeouts, Ref} catch _:_ -> ok end, - infinity; -tsrv_handle_msg(_GarbageMsg, _StaticState, Nxt) -> - Nxt. - -tsrv_delete_monitor_objects(RTab) -> - case ets:first(RTab) of - '$end_of_table' -> - ok; - TRef -> - erlang:demonitor(TRef), - ets:delete(RTab, TRef), - tsrv_delete_monitor_objects(RTab) - end. - -tsrv_handle_timeout(CallTime, #tsrv_state{rtab = RTab, - ttab = TTab} = S) -> - case ets:first(TTab) of - '$end_of_table' -> - infinity; - {Time, _TRef} when Time > CallTime -> - Time; - {_Time, TRef} = TKey -> - [{TKey, Proc, Msg}] = ets:lookup(TTab, TKey), - case erlang:is_pid(Proc) of - false -> ok; - _ -> erlang:demonitor(TRef) - end, - ets:delete(TTab, TKey), - ets:delete(RTab, TRef), - _ = try Proc ! Msg catch _:_ -> ok end, - tsrv_handle_timeout(CallTime, S) - end. diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 48c5c37717..bb56c9ff73 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -522,7 +522,6 @@ shutdown_pids(Heart,BootPid,State) -> Timer = shutdown_timer(State#state.flags), catch shutdown(State#state.kernel,BootPid,Timer,State), kill_all_pids(Heart), % Even the shutdown timer. - cancel_all_bif_timeouts(), kill_all_ports(Heart), flush_timout(Timer). @@ -581,30 +580,6 @@ resend([ExitMsg|Exits]) -> resend(_) -> ok. - -cancel_all_bif_timeouts() -> - TSrvs = erts_internal:get_bif_timer_servers(), - Ref = make_ref(), - {BTR, _TSrv} = erts_internal:access_bif_timer(Ref), %% Cheat... - request_cancel_all_bif_timeouts(Ref, BTR, TSrvs), - wait_response_cancel_all_bif_timeouts(Ref, BTR, TSrvs), - ok. - -request_cancel_all_bif_timeouts(_Ref, _BTR, []) -> - ok; -request_cancel_all_bif_timeouts(Ref, BTR, [TSrv|TSrvs]) -> - TSrv ! {cancel_all_timeouts, BTR, self(), {Ref, TSrv}}, - request_cancel_all_bif_timeouts(Ref, BTR, TSrvs). - -wait_response_cancel_all_bif_timeouts(_Ref, _BTR, []) -> - ok; -wait_response_cancel_all_bif_timeouts(Ref, BTR, [TSrv|TSrvs]) -> - receive - {canceled_all_timeouts, {Ref, TSrv}} -> - wait_response_cancel_all_bif_timeouts(Ref, BTR, TSrvs) - end. - - %% %% Kill all existing pids in the system (except init and heart). kill_all_pids(Heart) -> diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index f5ea8f160a..07966192c5 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -462,13 +462,10 @@ split_emu_clt([A|As], Emu, Misc, Extra, extra = Type) -> get_nodename(T) -> - {A, B, C} = now(), atom_to_list(T) ++ "-" ++ atom_to_list(?MODULE) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). + ++ integer_to_list(erlang:unique_integer([positive])). diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index 3b3e1bd8f9..f26508295c 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -48,7 +48,9 @@ XML_HTML_FILE = \ notes_history.xml XML_CHAPTER_FILES = \ - asn1_ug.xml \ + asn1_introduction.xml \ + asn1_getting_started.xml \ + asn1_overview.xml \ asn1_spec.xml \ notes.xml diff --git a/lib/asn1/doc/src/asn1_getting_started.xml b/lib/asn1/doc/src/asn1_getting_started.xml new file mode 100644 index 0000000000..1a9c279191 --- /dev/null +++ b/lib/asn1/doc/src/asn1_getting_started.xml @@ -0,0 +1,1290 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Getting Started</title> + <prepared>Kenneth Lundin</prepared> + <docno></docno> + <date>1999-03-25</date> + <rev>D</rev> + <file>asn1_getting_started.xml</file> + </header> + + <section> + <title>Example</title> + <p>The following example demonstrates the basic functionality used to + run the Erlang ASN.1 compiler.</p> + <p>Create a file named <c>People.asn</c> containing the following:</p> + <pre> +People DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + Person ::= SEQUENCE { + name PrintableString, + location INTEGER {home(0),field(1),roving(2)}, + age INTEGER OPTIONAL + } +END </pre> + <p>This file must be compiled before it can be used. + The ASN.1 compiler checks that the syntax is correct and that the + text represents proper ASN.1 code before generating an abstract + syntax tree. The code-generator then uses the abstract syntax + tree to generate code.</p> + <p>The generated Erlang files are placed in the current directory or + in the directory specified with option <c>{outdir,Dir}</c>.</p> + <p>The following shows how the compiler + can be called from the Erlang shell:</p> + + <pre> +1><input> asn1ct:compile("People", [ber]).</input> +ok +2> </pre> + + <p>Option <c>verbose</c> can be added to get information + about the generated files:</p> + <pre> +2><input> asn1ct:compile("People", [ber,verbose]).</input> +Erlang ASN.1 compiling "People.asn" +--{generated,"People.asn1db"}-- +--{generated,"People.hrl"}-- +--{generated,"People.erl"}-- +ok +3> </pre> + + <p>ASN.1 module <c>People</c> is now accepted and the + abstract syntax tree is saved in file <c>People.asn1db</c>. + The generated Erlang code is compiled using the Erlang compiler + and loaded into the Erlang runtime system. There is now an API + for <c>encode/2</c> and <c>decode/2</c> in module + <c>People</c>, which is called like:<br></br> + <c><![CDATA['People':encode(<Type name>, <Value>)]]></c> + <br></br> + or<br></br> +<c><![CDATA['People':decode(<Type name>, <Value>)]]></c></p> + + <p>Assume that there is a network + application that receives instances of the ASN.1 defined + type <c>Person</c>, modifies, and sends them back again:</p> + + <code type="none"> +receive + {Port,{data,Bytes}} -> + case 'People':decode('Person',Bytes) of + {ok,P} -> + {ok,Answer} = 'People':encode('Person',mk_answer(P)), + Port ! {self(),{command,Answer}}; + {error,Reason} -> + exit({error,Reason}) + end + end, </code> + <p>In this example, a series of bytes is received from an + external source and the bytes are then decoded into a valid + Erlang term. This was achieved with the call + <c>'People':decode('Person',Bytes)</c>, which returned + an Erlang value of the ASN.1 type <c>Person</c>. Then an answer was + constructed and encoded using + <c>'People':encode('Person',Answer)</c>, which takes an + instance of a defined ASN.1 type and transforms it to a + binary according to the BER or PER encoding rules.</p> + <p>The encoder and decoder can also be run from the shell:</p> + <pre> +2> <input>Rockstar = {'Person',"Some Name",roving,50}.</input> +{'Person',"Some Name",roving,50} +3> <input>{ok,Bin} = 'People':encode('Person',Rockstar).</input> +{ok,<<243,17,19,9,83,111,109,101,32,78,97,109,101,2,1,2, + 2,1,50>>} +4> <input>{ok,Person} = 'People':decode('Person',Bin).</input> +{ok,{'Person',"Some Name",roving,50}} +5> </pre> + + <section> + <title>Module Dependencies</title> + <p>It is common that ASN.1 modules import defined types, values, and + other entities from another ASN.1 module.</p> + <p>Earlier versions of the ASN.1 compiler required that modules + that were imported from had to be compiled before the module + that imported. This caused problems when ASN.1 modules had circular + dependencies.</p> + <p>Referenced modules are now parsed when the compiler finds an + entity that is imported. No code is generated for + the referenced module. However, the compiled modules rely on + that the referenced modules are also compiled.</p> + </section> + </section> + + <section> + <title>ASN.1 Application User Interface</title> + <p>The <c>ASN.1</c> application provides the following two + separate user interfaces:</p> + <list type="bulleted"> + <item> + <p>The module <c>asn1ct</c>, which provides the compile-time functions + (including the compiler)</p> + </item> + <item> + <p>The module <c>asn1rt_nif</c>, which provides the runtime functions + for the ASN.1 decoder for the BER back end</p> + </item> + </list> + <p>The reason for this division of the interfaces into compile-time + and runtime + is that only runtime modules (<c>asn1rt*</c>) need to be loaded in + an embedded system. + </p> + + <section> + <title>Compile-Time Functions</title> + <p>The ASN.1 compiler can be started directly from the command line + by the <c>erlc</c> program. This is convenient when compiling + many ASN.1 files from the command line or when using Makefiles. + Some examples of how the <c>erlc</c> command can be used to start + the ASN.1 compiler:</p> + <pre> +erlc Person.asn +erlc -bper Person.asn +erlc -bber ../Example.asn +erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn</pre> + <p>Useful options for the ASN.1 compiler:</p> + <taglist> + <tag><c>-b[ber | per | uper]</c></tag> + <item> + <p>Choice of encoding rules. If omitted, <c>ber</c> is the + default.</p> + </item> + <tag><c>-o OutDirectory</c></tag> + <item> + <p>Where to put the generated files. Default is the current + directory.</p> + </item> + <tag><c>-I IncludeDir</c></tag> + <item> + <p>Where to search for <c>.asn1db</c> files and ASN.1 + source specs to resolve references to other + modules. This option can be repeated many times if there + are several places to search in. The compiler + searches the current directory first.</p> + </item> + <tag><c>+der</c></tag> + <item> + <p>DER encoding rule. Only when using option <c>-ber</c>.</p> + </item> + <tag><c>+asn1config</c></tag> + <item> + <p>This functionality works together with option + <c>ber</c>. It enables the specialized decodes, see Section + <seealso marker="asn1_spec">Specialized Decode</seealso>.</p> + </item> + <tag><c>+undec_rest</c></tag> + <item> + <p>A buffer that holds a message being decoded can also have + trailing bytes. If those trailing bytes are important, they + can be returned along with the decoded value by compiling + the ASN.1 specification with option <c>+undec_rest</c>. + The return value from the decoder is + <c>{ok,Value,Rest}</c> where <c>Rest</c> is a binary + containing the trailing bytes.</p> + </item> + <tag><c>+'Any Erlc Option'</c></tag> + <item> + <p>Any option can be added to the Erlang compiler when + compiling the generated Erlang files. Any option + unrecognized by the ASN.1 compiler is passed to the + Erlang compiler.</p> + </item> + </taglist> + <p>For a complete description of <c>erlc</c>, see + ERTS Reference Manual.</p> + <p>The compiler and other compile-time functions can also be started + from the Erlang shell. Here follows a brief + description of the primary functions. For a + complete description of each function, see module <c>asn1ct</c> in + the <seealso marker="asn1ct">ASN.1 Reference Manual</seealso>.</p> + <p>The compiler is started by <c>asn1ct:compile/1</c> with + default options, or <c>asn1ct:compile/2</c> if explicit options + are given.</p> + <p>Example:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1"). </pre> + <p>This equals:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1",[ber]). </pre> + <p>If PER encoding is wanted:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1",[per]). </pre> + <p>The generic encode and decode functions can be called + as follows:</p> + <pre> +'H323-MESSAGES':encode('SomeChoiceType',{call,<<"octetstring">>}). +'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> + </section> + + <section> + <title>Runtime Functions</title> + <p>When an ASN.1 specification is compiled with option <c>ber</c>, + the <c>asn1rt_nif</c> module and the NIF library in + <c>asn1/priv_dir</c> are needed at runtime.</p> + <p>By calling function <c>info/0</c> in a generated module, you + get information about which compiler options were used.</p> + </section> + + <section> + <title>Errors</title> + <p>Errors detected at + compile-time are displayed on the screen together with line + numbers indicating where in the source file the respective error + was detected. If no errors are found, an Erlang ASN.1 module is + created.</p> + <p>The runtime encoders and decoders execute within a catch and + return <c>{ok, Data}</c> or + <c>{error, {asn1, Description}}</c> where + <c>Description</c> is + an Erlang term describing the error.</p> + </section> + </section> + + <section> + <marker id="inlineExamples"></marker> + <title>Multi-File Compilation</title> + <p>There are various reasons for using multi-file compilation:</p> + <list type="bulleted"> + <item>To choose the name for the generated module, for + example, because you need to compile the same specs for + different encoding rules.</item> + <item>You want only one resulting module.</item> + </list> + <p>Specify which ASN.1 specs to compile in a module with extension + <c>.set.asn</c>. Choose a module name and provide the + names of the ASN.1 specs. For example, if you have the specs + <c>File1.asn</c>, <c>File2.asn</c>, and <c>File3.asn</c>, your + module <c>MyModule.set.asn</c> looks as follows:</p> + <pre> +File1.asn +File2.asn +File3.asn </pre> + <p>If you compile with the following, the result is one merged + module <c>MyModule.erl</c> with the generated code from the three + ASN.1 specs:</p> + <code type="none"> +~> erlc MyModule.set.asn </code> + </section> + + <section> + <title>Remark about Tags</title> + + <p>Tags used to be important for all users of ASN.1, because it + was necessary to add tags manually to certain constructs in order + for the ASN.1 specification to be valid. Example of + an old-style specification:</p> + + <pre> +Tags DEFINITIONS ::= +BEGIN + Afters ::= CHOICE { cheese [0] IA5String, + dessert [1] IA5String } +END </pre> + + <p>Without the tags (the numbers in square brackets) the ASN.1 + compiler refused to compile the file.</p> + + <p>In 1994 the global tagging mode <c>AUTOMATIC TAGS</c> was introduced. + By putting <c>AUTOMATIC TAGS</c> in the module header, the ASN.1 + compiler automatically adds tags when needed. The following is the + same specification in <c>AUTOMATIC TAGS</c> mode:</p> + + <pre> +Tags DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + Afters ::= CHOICE { cheese IA5String, + dessert IA5String } +END </pre> + + <p>Tags are not mentioned any more in this User's Guide.</p> + </section> + + <section> + <marker id="ASN1Types"></marker> + <title>ASN.1 Types</title> + <p>This section describes the ASN.1 types including their + functionality, purpose, and how values are assigned in Erlang. + </p> + <p>ASN.1 has both primitive and constructed types:</p> + <p></p> + <table> + <row> + <cell align="left" valign="middle"><em>Primitive Types</em></cell> + <cell align="left" valign="middle"><em>Constructed Types</em></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#BOOLEAN">BOOLEAN</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SEQUENCE">SEQUENCE</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#INTEGER">INTEGER</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SET">SET</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#REAL">REAL</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#CHOICE">CHOICE</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#NULL">NULL</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SOF">SET OF and SEQUENCE OF</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#ENUMERATED">ENUMERATED</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#ANY">ANY</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#BIT STRING">BIT STRING</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#ANY">ANY DEFINED BY</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#OCTET STRING">OCTET STRING</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EXTERNAL</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#Character Strings">Character Strings</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EMBEDDED PDV</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#OBJECT IDENTIFIER">OBJECT IDENTIFIER</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">CHARACTER STRING</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#Object Descriptor">Object Descriptor</seealso></cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#The TIME types">TIME Types</seealso></cell> + <cell align="left" valign="middle"></cell> + </row> + <tcaption>Supported ASN.1 Types</tcaption> + </table> + <marker id="TypeNameValue"></marker> + <note> + <p>The values of each ASN.1 type have their own representation in Erlang, as + described in the following sections. Users must provide + these values for encoding according to the representation, as shown in the + following example:</p> + </note> + <pre> +Operational ::= BOOLEAN --ASN.1 definition </pre> + <p>In Erlang code it can look as follows:</p> + <pre> +Val = true, +{ok,Bytes} = MyModule:encode('Operational', Val), </pre> + + <section> + <marker id="BOOLEAN"></marker> + <title>BOOLEAN</title> + <p>Booleans in ASN.1 express values that can be either + <c>TRUE</c> or <c>FALSE</c>. + The meanings assigned to <c>TRUE</c> and <c>FALSE</c> are outside the scope + of this text.</p> + <p>In ASN.1 it is possible to have:</p> + <pre> +Operational ::= BOOLEAN</pre> + <p>Assigning a value to type <c>Operational</c> in Erlang is possible by + using the following Erlang code:</p> + <code type="erl"> +Myvar1 = true,</code> + <p>Thus, in Erlang the atoms <c>true</c> and <c>false</c> are used + to encode a boolean value.</p> + </section> + + <section> + <marker id="INTEGER"></marker> + <title>INTEGER</title> + <p>ASN.1 itself specifies indefinitely large integers. Erlang + systems with version 4.3 and higher support very large + integers, in practice indefinitely large integers.</p> + <p>The concept of subtyping can be applied to integers and + to other ASN.1 types. The details of subtyping are not + explained here; for more information, see X.680. Various + syntaxes are allowed when defining a type as an integer:</p> + <pre> +T1 ::= INTEGER +T2 ::= INTEGER (-2..7) +T3 ::= INTEGER (0..MAX) +T4 ::= INTEGER (0<..MAX) +T5 ::= INTEGER (MIN<..-99) +T6 ::= INTEGER {red(0),blue(1),white(2)}</pre> + <p>The Erlang representation of an ASN.1 <c>INTEGER</c> is an integer or + an atom if a <c>Named Number List</c> (see <c>T6</c> in the previous + list) is specified.</p> + <p>The following is an example of Erlang code that assigns values for the + types in the previous list:</p> + <pre> +T1value = 0, +T2value = 6, +T6value1 = blue, +T6value2 = 0, +T6value3 = white</pre> + <p>These Erlang variables are now bound to valid instances of + ASN.1 defined types. This style of value can be passed directly + to the encoder for transformation into a series of bytes.</p> + <p>The decoder returns an atom if the value corresponds to a + symbol in the <c>Named Number List</c>.</p> + </section> + + <section> + <marker id="REAL"></marker> + <title>REAL</title> + <p>The following ASN.1 type is used for real numbers:</p> + <pre> +R1 ::= REAL</pre> + <p>It is assigned a value in Erlang as follows:</p> + <pre> +R1value1 = "2.14", +R1value2 = {256,10,-2},</pre> + <p>In the last line, notice that the tuple {256,10,-2} is the real number + 2.56 in a special notation, which encodes faster than simply + stating the number as <c>"2.56"</c>. The arity three tuple is + <c>{Mantissa,Base,Exponent}</c>, that is, Mantissa * Base^Exponent.</p> + </section> + + <section> + <marker id="NULL"></marker> + <title>NULL</title> + <p>The type <c>NULL</c> is suitable where supply and recognition of a value + is important but the actual value is not.</p> + <pre> +Notype ::= NULL</pre> + <p>This type is assigned in Erlang as follows:</p> + <pre> +N1 = 'NULL',</pre> + <p>The actual value is the quoted atom <c>'NULL'</c>.</p> + </section> + + <section> + <marker id="ENUMERATED"></marker> + <title>ENUMERATED</title> + <p>The type <c>ENUMERATED</c> can be used when the value you want to + describe can only take one of a set of predefined values. Example:</p> + <pre> +DaysOfTheWeek ::= ENUMERATED { + sunday(1),monday(2),tuesday(3), + wednesday(4),thursday(5),friday(6),saturday(7) }</pre> + <p>For example, to assign a weekday value in Erlang, use the same atom + as in the <c>Enumerations</c> of the type definition:</p> + <pre> +Day1 = saturday,</pre> + <p>The enumerated type is similar to an integer type, when + defined with a set of predefined values. The difference is that + an enumerated type can only have specified + values, whereas an integer can have any value.</p> + </section> + + <section> + <marker id="BIT STRING"></marker> + <title>BIT STRING</title> + <p>The type <c>BIT STRING</c> can be used to model information that + is made up of arbitrary length series of bits. It is intended + to be used for selection of flags, not for binary files.</p> + <p>In ASN.1, <c>BIT STRING</c> definitions can look as follows:</p> + <pre> +Bits1 ::= BIT STRING +Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)}</pre> + <p>The following two notations are available for representation of <c>BIT + STRING</c> values in Erlang and as input to the encode functions:</p> + <list type="ordered"> + <item>A bitstring. By default, a <c>BIT STRING</c> with no + symbolic names is decoded to an Erlang bitstring.</item> + <item>A list of atoms corresponding to atoms in the <c>NamedBitList</c> + in the <c>BIT STRING</c> definition. A <c>BIT STRING</c> with symbolic + names is always decoded to the format shown in the following + example:</item> + </list> + <pre> +Bits1Val1 = <<0:1,1:1,0:1,1:1,1:1>>, +Bits2Val1 = [gnu,punk], +Bits2Val2 = <<2#1110:4>>, +Bits2Val3 = [bar,gnu,gnome],</pre> + <p><c>Bits2Val2</c> and <c>Bits2Val3</c> denote the same value.</p> + <p><c>Bits2Val1</c> is assigned symbolic values. The assignment means + that the bits corresponding to <c>gnu</c> and <c>punk</c>, that is, bits + 2 and 14 are set to 1, and the rest are set to 0. The symbolic values + are shown as a list of values. If a named value, which is not + specified in the type definition, is shown, a runtime error occurs.</p> + <p><c>BIT STRING</c>s can also be subtyped with, for example, a <c>SIZE</c> + specification:</p> + <pre> +Bits3 ::= BIT STRING (SIZE(0..31)) </pre> + <p>This means that no bit higher than 31 can be set.</p> + + <section> + <title>Deprecated Representations for BIT STRING</title> + <p>In addition to the representations described earlier, the + following deprecated representations are available if the + specification has been compiled with option + <c>legacy_erlang_types</c>:</p> + <list type="ordered"> + <item>Aa a list of binary digits (0 or 1). This format is + accepted as input to the encode functions, and a <c>BIT STRING</c> + is decoded to this format if option + <em>legacy_bit_string</em> is given. + </item> + <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes + how many trailing zero-bits 0-7 that are unused in the + least significant byte in <c>Binary</c>. This format is + accepted as input to the encode functions, and a <c>BIT + STRING</c> is decoded to this format if + <c>compact_bit_string</c> has been given. + </item> + <item>As a hexadecimal number (or an integer). Avoid this + as it is easy to misinterpret a <c>BIT + STRING</c> value in this format. + </item> + </list> + </section> + </section> + + <section> + <marker id="OCTET STRING"></marker> + <title>OCTET STRING</title> + <p><c>OCTET STRING</c> is the simplest of all ASN.1 types. <c>OCTET + STRING</c> only moves or transfers, for example, binary files or other + unstructured information complying with two rules: the + bytes consist of octets and encoding is not required.</p> + <p>It is possible to have the following ASN.1 type definitions:</p> + <pre> +O1 ::= OCTET STRING +O2 ::= OCTET STRING (SIZE(28)) </pre> + <p>With the following example assignments in Erlang:</p> + <pre> +O1Val = <<17,13,19,20,0,0,255,254>>, +O2Val = <<"must be exactly 28 chars....">>,</pre> + <p>By default, an <c>OCTET STRING</c> is always represented as + an Erlang binary. If the specification has been compiled with + option <c>legacy_erlang_types</c>, the encode functions + accept both lists and binaries, and the decode functions + decode an <c>OCTET STRING</c> to a list.</p> + </section> + + <section> + <marker id="Character Strings"></marker> + <title>Character Strings</title> + <p>ASN.1 supports a wide variety of character sets. The main difference + between an <c>OCTET STRING</c> and a character string is that the + <c>OCTET STRING</c> has no imposed semantics on the bytes delivered.</p> + <p>However, when using, for example, IA5String (which closely + resembles ASCII), byte 65 (in decimal + notation) <em>means</em> character 'A'. + </p> + <p>For example, if a defined type is to be a VideotexString and + an octet is received with the unsigned integer value <c>X</c>, + the octet is to be interpreted as specified in standard + ITU-T T.100, T.101. + </p> + <p>The ASN.1 to Erlang compiler + does not determine the correct interpretation of each BER + string octet value with different character strings. The + application is responsible for interpretation + of octets. Therefore, from the BER + string point of view, octets are very similar to + character strings and are compiled in the same way. + </p> + <p>When PER is + used, there is a significant difference in the encoding scheme + between <c>OCTET STRING</c>s and other strings. The constraints + specified for a type are especially important for PER, where + they affect the encoding. + </p> + <p>Examples:</p> + <pre> +Digs ::= NumericString (SIZE(1..3)) +TextFile ::= IA5String (SIZE(0..64000)) </pre> + <p>The corresponding Erlang assignments:</p> + <pre> +DigsVal1 = "456", +DigsVal2 = "123", +TextFileVal1 = "abc...xyz...", +TextFileVal2 = [88,76,55,44,99,121 .......... a lot of characters here ....]</pre> + <p>The Erlang representation for "BMPString" and + "UniversalString" is either a list of ASCII values or a list + of quadruples. The quadruple representation associates to the + Unicode standard representation of characters. The ASCII + characters are all represented by quadruples beginning with + three zeros like {0,0,0,65} for character 'A'. When + decoding a value for these strings, the result is a list of + quadruples, or integers when the value is an ASCII character.</p> + + <p>The following example shows how it works. Assume the following + specification is in file <c>PrimStrings.asn1</c>:</p> + <pre> +PrimStrings DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + BMP ::= BMPString +END </pre> + + <p>Encoding and decoding some strings:</p> + + <pre> +1> <input>asn1ct:compile('PrimStrings', [ber]).</input> +ok +2> <input>{ok,Bytes1} = 'PrimStrings':encode('BMP', [{0,0,53,53},{0,0,45,56}]).</input> +{ok,<<30,4,53,54,45,56>>} +3> <input>'PrimStrings':decode('BMP', Bytes1).</input> +{ok,[{0,0,53,53},{0,0,45,56}]} +4> <input>{ok,Bytes2} = 'PrimStrings':encode('BMP', [{0,0,53,53},{0,0,0,65}]).</input> +{ok,<<30,4,53,53,0,65>>} +5> <input>'PrimStrings':decode('BMP', Bytes2).</input> +{ok,[{0,0,53,53},65]} +6> <input>{ok,Bytes3} = 'PrimStrings':encode('BMP', "BMP string").</input> +{ok,<<30,20,0,66,0,77,0,80,0,32,0,115,0,116,0,114,0,105,0,110,0,103>>} +7> <input>'PrimStrings':decode('BMP', Bytes3).</input> +{ok,"BMP string"} </pre> + + <p>Type UTF8String is represented as a UTF-8 encoded binary in + Erlang. Such binaries can be created directly using the binary syntax + or by converting from a list of Unicode code points using function + <c>unicode:characters_to_binary/1</c>.</p> + + <p>The following shows examples of how UTF-8 encoded binaries can + be created and manipulated:</p> + <pre> +1> <input>Gs = "Мой маленький Гном".</input> +[1052,1086,1081,32,1084,1072,1083,1077,1085,1100,1082,1080, + 1081,32,1043,1085,1086,1084] +2> <input>Gbin = unicode:characters_to_binary(Gs).</input> +<<208,156,208,190,208,185,32,208,188,208,176,208,187,208, + 181,208,189,209,140,208,186,208,184,208,185,32,208,147, + 208,...>> +3> <input>Gbin = <<"Мой маленький Гном"/utf8>>.</input> +<<208,156,208,190,208,185,32,208,188,208,176,208,187,208, + 181,208,189,209,140,208,186,208,184,208,185,32,208,147, + 208,...>> +4> <input>Gs = unicode:characters_to_list(Gbin).</input> +[1052,1086,1081,32,1084,1072,1083,1077,1085,1100,1082,1080, + 1081,32,1043,1085,1086,1084]</pre> + + <p>For details, see the <seealso marker="stdlib:unicode">unicode</seealso> + module in <c>stdlib</c>.</p> + + <p>In the following example, this ASN.1 specification is used:</p> + <pre> +UTF DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + UTF ::= UTF8String +END </pre> + + <p>Encoding and decoding a string with Unicode characters:</p> + + <pre> +5> <input>asn1ct:compile('UTF', [ber]).</input> +ok +6> <input>{ok,Bytes1} = 'UTF':encode('UTF', <<"Гном"/utf8>>).</input> +{ok,<<12,8,208,147,208,189,208,190,208,188>>} +7> <input>{ok,Bin1} = 'UTF':decode('UTF', Bytes1).</input> +{ok,<<208,147,208,189,208,190,208,188>>} +8> <input>io:format("~ts\n", [Bin1]).</input> +Гном +ok +9> <input>unicode:characters_to_list(Bin1).</input> +[1043,1085,1086,1084] </pre> + </section> + + <section> + <marker id="OBJECT IDENTIFIER"></marker> + <title>OBJECT IDENTIFIER</title> + <p>The type <c>OBJECT IDENTIFIER</c> is used whenever a unique identity is + required. An ASN.1 module, a transfer syntax, and so on, is identified + with an <c>OBJECT IDENTIFIER</c>. Assume the following example:</p> + <pre> +Oid ::= OBJECT IDENTIFIER</pre> + <p>Therefore, the following example is a valid Erlang instance of + type 'Oid':</p> + <pre> +OidVal1 = {1,2,55},</pre> + <p>The <c>OBJECT IDENTIFIER</c> value is simply a tuple with the + consecutive values, which must be integers. + </p> + <p>The first value is limited to the values 0, 1, or 2. The + second value must be in the range 0..39 when the first value + is 0 or 1. + </p> + <p>The <c>OBJECT IDENTIFIER</c> is an important type and it is + widely used within different standards to identify various + objects uniquely. Dubuisson: ASN.1 - Communication Between + Heterogeneous Systems includes an + easy-to-understand description of the use of + <c>OBJECT IDENTIFIER</c>.</p> + </section> + + <section> + <marker id="Object Descriptor"></marker> + <title>Object Descriptor</title> + <p>Values of this type can be assigned a value as an ordinary string + as follows:</p> + + <pre> + "This is the value of an Object descriptor"</pre> + </section> + + <section> + <marker id="The TIME types"></marker> + <title>TIME Types</title> + <p>Two time types are defined within ASN.1: Generalized + Time and Universal Time Coordinated (UTC). Both are assigned a + value as an ordinary string within double quotes, for example, + "19820102070533.8".</p> + <p>For DER encoding, the compiler does not check the validity + of the time values. The DER requirements upon those strings are + regarded as a matter for the application to fulfill.</p> + </section> + + <section> + <marker id="SEQUENCE"></marker> + <title>SEQUENCE</title> + <p>The structured types of ASN.1 are constructed from other types + in a manner similar to the concepts of array and struct in C.</p> + <p>A <c>SEQUENCE</c> in ASN.1 is + comparable with a struct in C and a record in Erlang. + A <c>SEQUENCE</c> can be defined as follows:</p> + <pre> +Pdu ::= SEQUENCE { + a INTEGER, + b REAL, + c OBJECT IDENTIFIER, + d NULL } </pre> + <p>This is a 4-component structure called <c>Pdu</c>. The record format + is the major format for representation of <c>SEQUENCE</c> in Erlang. + For each <c>SEQUENCE</c> and <c>SET</c> in an ASN.1 module an Erlang + record declaration is generated. For <c>Pdu</c>, a record + like the following is defined:</p> + <pre> +-record('Pdu',{a, b, c, d}). </pre> + <p>The record declarations for a module <c>M</c> are placed in a + separate <c>M.hrl</c> file.</p> + <p>Values can be assigned in Erlang as follows:</p> + <pre> +MyPdu = #'Pdu'{a=22,b=77.99,c={0,1,2,3,4},d='NULL'}. </pre> + <p>The decode functions return a record as result when decoding + a <c>SEQUENCE</c> or a <c>SET</c>.</p> + + <p>A <c>SEQUENCE</c> and a <c>SET</c> can contain a component + with a <c>DEFAULT</c> keyword followed by the actual value, which + is the default value. The <c>DEFAULT</c> keyword means that the + application doing the encoding can omit encoding of the value, which + results in fewer bytes to send to the receiving application.</p> + + <p>An application can use the atom <c>asn1_DEFAULT</c> to indicate + that the encoding is to be omitted for that position in + the <c>SEQUENCE</c>.</p> + + <p>Depending on the encoding rules, the encoder can also compare + the given value to the default value and automatically omit the + encoding if the values are equal. How much effort the encoder makes + to compare the values depends on the encoding rules. The DER + encoding rules forbid encoding a value equal to the default value, + so it has a more thorough and time-consuming comparison than the + encoders for the other encoding rules.</p> + + <p>In the following example, this ASN.1 specification is used:</p> + <pre> +File DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +Seq1 ::= SEQUENCE { + a INTEGER DEFAULT 1, + b Seq2 DEFAULT {aa TRUE, bb 15} +} + +Seq2 ::= SEQUENCE { + aa BOOLEAN, + bb INTEGER +} + +Seq3 ::= SEQUENCE { + bs BIT STRING {a(0), b(1), c(2)} DEFAULT {a, c} +} +END </pre> + <p>Example where the BER encoder is able to omit encoding + of the default values:</p> + <pre> +1> <input>asn1ct:compile('File', [ber]).</input> +ok +2> <input>'File':encode('Seq1', {'Seq1',asn1_DEFAULT,asn1_DEFAULT}).</input> +{ok,<<48,0>>} +3> <input>'File':encode('Seq1', {'Seq1',1,{'Seq2',true,15}}).</input> +{ok,<<48,0>>} </pre> + + <p>Example with a named <c>BIT STRING</c> where the BER + encoder does not omit the encoding:</p> + <pre> +4> <input>'File':encode('Seq3', {'Seq3',asn1_DEFAULT).</input> +{ok,<<48,0>>} +5> <input>'File':encode('Seq3', {'Seq3',<<16#101:3>>).</input> +{ok,<<48,4,128,2,5,160>>} </pre> + + <p>The DER encoder omits the encoding for the same <c>BIT STRING</c>:</p> + <pre> +6> <input>asn1ct:compile('File', [ber,der]).</input> +ok +7> <input>'File':encode('Seq3', {'Seq3',asn1_DEFAULT).</input> +{ok,<<48,0>>} +8> <input>'File':encode('Seq3', {'Seq3',<<16#101:3>>).</input> +{ok,<<48,0>>} </pre> + </section> + + <section> + <marker id="SET"></marker> + <title>SET</title> + <p>In Erlang, the <c>SET</c> type is used exactly as <c>SEQUENCE</c>. + Notice that if BER or DER encoding rules are used, decoding a + <c>SET</c> is slower than decoding a <c>SEQUENCE</c> because the + components must be sorted.</p> + </section> + + <section> + <title>Extensibility for SEQUENCE and SET</title> + <p>When a <c>SEQUENCE</c> or <c>SET</c> contains an extension marker + and extension components as the following, the type can get more + components in newer versions of the ASN.1 spec:</p> + <pre> +SExt ::= SEQUENCE { + a INTEGER, + ..., + b BOOLEAN }</pre> + <p>In this case it has got a new + component <c>b</c>. Thus, incoming messages that are decoded + can have more or fever components than this one. + </p> + <p>The component <c>b</c> is treated as + an original component when encoding a message. In this case, as + it is not an optional element, it must be encoded. + </p> + <p>During decoding, the <c>b</c> field of the record gets the decoded + value of the <c>b</c> + component, if present, otherwise the value <c>asn1_NOVALUE</c>.</p> + </section> + + <section> + <marker id="CHOICE"></marker> + <title>CHOICE</title> + <p>The type <c>CHOICE</c> is a space saver and is similar to the + concept of a 'union' in C.</p> + <p>Assume the following:</p> + <pre> +SomeModuleName DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +T ::= CHOICE { + x REAL, + y INTEGER, + z OBJECT IDENTIFIER } +END </pre> + <p>It is then possible to assign values as follows:</p> + <pre> +TVal1 = {y,17}, +TVal2 = {z,{0,1,2}},</pre> + <p>A <c>CHOICE</c> value is always represented as the tuple + <c>{ChoiceAlternative, Val}</c> where <c>ChoiceAlternative</c> + is an atom denoting the selected choice alternative. + </p> + + <section> + <title>Extensible CHOICE</title> + <p>When a <c>CHOICE</c> contains an extension marker and the + decoder detects an unknown alternative of the <c>CHOICE</c>, + the value is represented as follows:</p> + <pre> +{asn1_ExtAlt, BytesForOpenType}</pre> + <p>Here <c>BytesForOpenType</c> is a list of bytes constituting the + encoding of the "unknown" <c>CHOICE</c> alternative.</p> + </section> + </section> + + <section> + <marker id="SOF"></marker> + <title>SET OF and SEQUENCE OF</title> + <p>The types <c>SET OF</c> and <c>SEQUENCE OF</c> correspond + to the concept of an array + in several programming languages. The Erlang syntax for + both types is straightforward, for example:</p> + <pre> +Arr1 ::= SET SIZE (5) OF INTEGER (4..9) +Arr2 ::= SEQUENCE OF OCTET STRING </pre> + <p>In Erlang the following can apply:</p> + <pre> +Arr1Val = [4,5,6,7,8], +Arr2Val = ["abc",[14,34,54],"Octets"], </pre> + <p>Notice that the definition of type <c>SET OF</c> implies that + the order of the components is undefined, but in practice there is + no difference between <c>SET OF</c> and <c>SEQUENCE OF</c>. + The ASN.1 compiler for Erlang does not randomize the order of the + <c>SET OF</c> components before encoding.</p> + <p>However, for a value of type <c>SET OF</c>, the DER + encoding format requires the elements to be sent in ascending + order of their encoding, which implies an expensive sorting + procedure in runtime. Therefore it is recommended to + use <c>SEQUENCE OF</c> instead of <c>SET OF</c> if possible.</p> + </section> + + <section> + <marker id="ANY"></marker> + <title>ANY and ANY DEFINED BY</title> + <p>The types <c>ANY</c> and <c>ANY DEFINED BY</c> have been removed + from the standard since 1994. It is recommended not to use + these types any more. They can, however, exist in some old ASN.1 + modules. The idea with this type was to leave a "hole" in a + definition where it was possible to + put unspecified data of any kind, even non-ASN.1 data.</p> + <p>A value of this type is encoded as an <c>open type</c>.</p> + <p>Instead of <c>ANY</c> and <c>ANY DEFINED BY</c>, it is + recommended to use + <c>information object class</c>, <c>table constraints</c>, and + <c>parameterization</c>. In particular the construct + <c>TYPE-IDENTIFIER.@Type</c> accomplish the same as the + deprecated <c>ANY</c>.</p> + <p>See also + <seealso marker="#Information Object">Information object</seealso>.</p> + </section> + + <section> + <marker id="NegotiationTypes"></marker> + <title>EXTERNAL, EMBEDDED PDV, and CHARACTER STRING</title> + <p>The types <c>EXTERNAL</c>, <c>EMBEDDED PDV</c>, and + <c>CHARACTER STRING</c> are used in presentation layer negotiation. + They are encoded according to their associated type, see X.680.</p> + <p>The type <c>EXTERNAL</c> had a slightly different associated type + before 1994. X.691 states that encoding must follow + the older associated type. So, generated encode/decode + functions convert values of the newer format to the older format + before encoding. This implies that it is allowed to use + <c>EXTERNAL</c> type values of either format for encoding. Decoded + values are always returned in the newer format.</p> + </section> + + <section> + <title>Embedded Named Types</title> + <p>The structured types previously described can have other named + types as their components. The general syntax to assign a value + to component <c>C</c> of a named ASN.1 type <c>T</c> in Erlang + is the record syntax <c>#'T'{'C'=Value}</c>. + Here <c>Value</c> can be a value of yet another type <c>T2</c>, + for example:</p> + <pre> +EmbeddedExample DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +B ::= SEQUENCE { + a Arr1, + b T } + +Arr1 ::= SET SIZE (5) OF INTEGER (4..9) + +T ::= CHOICE { + x REAL, + y INTEGER, + z OBJECT IDENTIFIER } + END </pre> + <p><c>SEQUENCE</c> <c>b</c> can be encoded as follows in Erlang:</p> + <pre> +1> 'EmbeddedExample':encode('B', {'B',[4,5,6,7,8],{x,"7.77"}}). +{ok,<<5,56,0,8,3,55,55,55,46,69,45,50>>} </pre> + </section> + </section> + + <section> + <title>Naming of Records in .hrl Files</title> + <p>When an ASN.1 specification is compiled, all defined types of type + <c>SET</c> or <c>SEQUENCE</c> result in a corresponding record in the + generated <c>.hrl</c> file. This is because the values for + <c>SET</c> and <c>SEQUENCE</c> are represented as records as + mentioned earlier.</p> + <p>Some special cases of this functionality are presented in the + next section.</p> + + <section> + <title>Embedded Structured Types</title> + <p>In ASN.1 it is also possible to have components that are themselves + structured types. + For example, it is possible to have the following:</p> + <pre> +Emb ::= SEQUENCE { + a SEQUENCE OF OCTET STRING, + b SET { + a INTEGER, + b INTEGER DEFAULT 66}, + c CHOICE { + a INTEGER, + b FooType } } + +FooType ::= [3] VisibleString </pre> + <p>The following records are generated because of type <c>Emb</c>:</p> + <pre> +-record('Emb,{a, b, c}). +-record('Emb_b',{a, b = asn1_DEFAULT}). % the embedded SET type </pre> + <p>Values of type <c>Emb</c> can be assigned as follows:</p> + <code type="none"> +V = #'Emb'{a=["qqqq",[1,2,255]], + b = #'Emb_b'{a=99}, + c ={b,"Can you see this"}}.</code> + <p>For an embedded type of type <c>SEQUENCE</c>/<c>SET</c> in a + <c>SEQUENCE</c>/<c>SET</c>, the record name is extended with an + underscore and the component name. If the embedded structure is + deeper with the <c>SEQUENCE</c>, <c>SET</c>, or <c>CHOICE</c> + types in the line, each component name/alternative name is + added to the record name.</p> + <p>Example:</p> + <pre> +Seq ::= SEQUENCE{ + a CHOICE{ + b SEQUENCE { + c INTEGER + } + } +} </pre> + <p>This results in the following record:</p> + <pre> +-record('Seq_a_b',{c}). </pre> + <p>If the structured type has a component with an embedded + <c>SEQUENCE OF</c>/<c>SET OF</c> which embedded type in turn + is a <c>SEQUENCE</c>/<c>SET</c>, it gives a record with the + <c>SEQUENCE OF</c>/<c>SET OF</c> + addition as in the following example:</p> + <pre> +Seq ::= SEQUENCE { + a SEQUENCE OF SEQUENCE { + b + } + c SET OF SEQUENCE { + d + } +} </pre> + <p>This results in the following records:</p> + <pre> +-record('Seq_a_SEQOF'{b}). +-record('Seq_c_SETOF'{d}). </pre> + <p>A parameterized type is to be considered as an embedded + type. Each time such a type is referenced, an instance of it is + defined. Thus, in the following example a record with name + <c>'Seq_b'</c> is generated in the <c>.hrl</c> file and is used + to hold values:</p> + <pre> +Seq ::= SEQUENCE { + b PType{INTEGER} +} + +PType{T} ::= SEQUENCE{ + id T +} </pre> + </section> + + <section> + <title>Recursive Types</title> + <p>Types that refer to themselves are called recursive types. + Example:</p> + <pre> +Rec ::= CHOICE { + nothing NULL, + something SEQUENCE { + a INTEGER, + b OCTET STRING, + c Rec }} </pre> + <p>This is allowed in ASN.1 and the ASN.1-to-Erlang compiler + supports this recursive type. + A value for this type is assigned in Erlang as follows:</p> + <pre> +V = {something,#'Rec_something'{a = 77, + b = "some octets here", + c = {nothing,'NULL'}}}. </pre> + </section> + </section> + + <section> + <title>ASN.1 Values</title> + <p>Values can be assigned to an ASN.1 type within the ASN.1 code + itself, as opposed to the actions in the previous section where + a value was assigned to an ASN.1 type in Erlang. The full value + syntax of ASN.1 is supported and X.680 describes in detail how + to assign values in ASN.1. A short example:</p> + <pre> +TT ::= SEQUENCE { + a INTEGER, + b SET OF OCTET STRING } + +tt TT ::= {a 77,b {"kalle","kula"}} </pre> + <p>The value defined here can be used in several ways. It can, for + example, be used as the value in some <c>DEFAULT</c> component:</p> + <pre> +SS ::= SET { + s OBJECT IDENTIFIER, + val TT DEFAULT tt } </pre> + <p>It can also be used from inside an Erlang program. If this ASN.1 + code is defined in ASN.1 module <c>Values</c>, the ASN.1 value + <c>tt</c> can be reached from Erlang as a function call to + <c>'Values':tt()</c> as in the following example:</p> + <pre> +1> <input>Val = 'Values':tt().</input> +{'TT',77,["kalle","kula"]} +2> <input>{ok,Bytes} = 'Values':encode('TT',Val).</input> +{ok,<<48,18,128,1,77,161,13,4,5,107,97,108,108,101,4,4, + 107,117,108,97>>} +4> <input>'Values':decode('TT',Bytes).</input> +{ok,{'TT',77,["kalle","kula"]}} +5> </pre> + <p>This example shows that a function is generated by the compiler + that returns a valid Erlang representation of the value, although + the value is of a complex type.</p> + <p>Furthermore, a macro is generated for each value in the <c>.hrl</c> + file. So, the defined value <c>tt</c> can also be extracted by + <c>?tt</c> in application code.</p> + </section> + + <section> + <title>Macros</title> + <p>The type <c>MACRO</c> is not supported. It is no longer part of + the ASN.1 standard.</p> + </section> + + <section> + <marker id="Information Object"></marker> + <title>ASN.1 Information Objects (X.681)</title> + <p>Information Object Classes, Information Objects, and Information + Object Sets (in the following called classes, objects, and + object sets, respectively) are defined in the standard + definition X.681. Only a brief explanation is given here.</p> + <p>These constructs makes it possible to define open types, that + is, values of that type can be of any ASN.1 type. Also, + relationships can be defined between different types and + values, as classes can hold types, values, objects, object + sets, and other classes in their fields. A class can be + defined in ASN.1 as follows:</p> + <pre> +GENERAL-PROCEDURE ::= CLASS { + &Message, + &Reply OPTIONAL, + &Error OPTIONAL, + &id PrintableString UNIQUE +} +WITH SYNTAX { + NEW MESSAGE &Message + [REPLY &Reply] + [ERROR &Error] + ADDRESS &id +} </pre> + <p>An object is an instance of a class. An object set is a set + containing objects of a specified class. A definition can look + as follows:</p> + <pre> +object1 GENERAL-PROCEDURE ::= { + NEW MESSAGE PrintableString + ADDRESS "home" +} + +object2 GENERAL-PROCEDURE ::= { + NEW MESSAGE INTEGER + ERROR INTEGER + ADDRESS "remote" +}</pre> + <p>The object <c>object1</c> is an instance of the class + <c>GENERAL-PROCEDURE</c> and has one type field and one + fixed type value field. The object <c>object2</c> has also an + optional field <c>ERROR</c>, which is a type field. The field + <c>ADDRESS</c> is a <c>UNIQUE</c> field. Objects in an object set + must have unique values in their <c>UNIQUE</c> field, as in + <c>GENERAL-PROCEDURES</c>:</p> + <pre> +GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { + object1 | object2} </pre> + <p>You cannot encode a class, object, or object set, only refer to + it when defining other ASN.1 entities. Typically you refer to a + class as well as to object sets by table constraints and component + relation constraints (X.682) in ASN.1 types, as in the following:</p> + <pre> +StartMessage ::= SEQUENCE { + msgId GENERAL-PROCEDURE.&id ({GENERAL-PROCEDURES}), + content GENERAL-PROCEDURE.&Message ({GENERAL-PROCEDURES}{@msgId}), + } </pre> + <p>In type <c>StartMessage</c>, the constraint following field + <c>content</c> tells that in a value of type + <c>StartMessage</c> the value in field <c>content</c> must + come from the same object that is chosen by field <c>msgId</c>.</p> + <p>So, the value + <c>#'StartMessage'{msgId="home",content="Any Printable String"}</c> + is legal to encode as a <c>StartMessage</c> value. However, the value + <c>#'StartMessage'{msgId="remote", content="Some String"}</c> + is illegal as the constraint in <c>StartMessage</c> tells that + when you have chosen a value from a specific object in object + set <c>GENERAL-PROCEDURES</c> in field + <c>msgId</c>, you must choose a value from that same object in + the content field too. In this second case, it is to be + any <c>INTEGER</c> value.</p> + <p><c>StartMessage</c> can in field <c>content</c> be + encoded with a value of any type that an object in object set + <c>GENERAL-PROCEDURES</c> has in its <c>NEW MESSAGE</c> field. + This field refers to a type field + <c>&Message</c> in the class. Field <c>msgId</c> is always + encoded as a <c>PrintableString</c>, as the field refers to a + fixed type in the class.</p> + <p>In practice, object sets are usually declared to be extensible so + that more objects can be added to the set later. Extensibility is + indicated as follows:</p> + <pre> +GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { + object1 | object2, ...} </pre> + <p>When decoding a type that uses an extensible set constraint, + it is always possible that the value in field <c>UNIQUE</c> + is unknown (that is, the type has been encoded with a later + version of the ASN.1 specification). The unencoded data is then + returned wrapped in a tuple as follows:</p> + + <pre> +{asn1_OPENTYPE,Binary}</pre> + + <p>Here <c>Binary</c> is an Erlang binary that contains the encoded + data. (If option <c>legacy_erlang_types</c> has been given, + only the binary is returned.)</p> + </section> + + <section> + <title>Parameterization (X.683)</title> + <p>Parameterization, which is defined in X.683, can be used when + defining types, values, value sets, classes, objects, or object sets. + A part of a definition can be supplied as a parameter. For + example, if a <c>Type</c> is used in a definition with a certain + purpose, you want the type name to express the intention. This + can be done with parameterization.</p> + <p>When many types (or another ASN.1 entity) only differ in some + minor cases, but the structure of the types is similar, only + one general type can be defined and the differences can be supplied + through parameters.</p> + <p>Example of use of parameterization:</p> + <pre> +General{Type} ::= SEQUENCE +{ + number INTEGER, + string Type +} + +T1 ::= General{PrintableString} + +T2 ::= General{BIT STRING}</pre> + <p>An example of a value that can be encoded as type <c>T1</c> is + <c>{12,"hello"}</c>.</p> + <p>Notice that the compiler does not generate encode/decode functions + for parameterized types, only for the instances of the parameterized + types. Therefore, if a file contains the types <c>General{}</c>, + <c>T1</c>, and <c>T2</c> as in the previous example, encode/decode + functions are only generated for <c>T1</c> and <c>T2</c>. + </p> + </section> +</chapter> + diff --git a/lib/asn1/doc/src/asn1_introduction.xml b/lib/asn1/doc/src/asn1_introduction.xml new file mode 100644 index 0000000000..ae0379684a --- /dev/null +++ b/lib/asn1/doc/src/asn1_introduction.xml @@ -0,0 +1,99 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Introduction</title> + <prepared></prepared> + <docno></docno> + <date>2015-03-31</date> + <rev>A</rev> + <file>asn1_introduction.xml</file> + </header> + + <p>The <c>ASN.1</c> application provides the following:</p> + + <list type="bulleted"> + <item>An ASN.1 compiler for Erlang, which generates encode and + decode functions to be used by Erlang programs sending and + receiving ASN.1 specified data.</item> + <item>Runtime functions used by the generated code.</item> + <item>Support for the following encoding rules: + <list><item>Basic Encoding Rules (BER)</item> + <item>Distinguished Encoding Rules (DER), a specialized form of + BER that is used in security-conscious applications</item> + <item>Packed Encoding Rules (PER), both the aligned and + unaligned variant</item> + </list> + </item> + </list> + + <section> + <title>Scope</title> + <p>This application covers all features of ASN.1 up to the 1997 + edition of the specification. In the 2002 edition, + new features were introduced. The following features + of the 2002 edition are fully or partly supported:</p> + <list type="bulleted"> + <item> + <p>Decimal notation (for example, <c>"1.5e3</c>) for REAL values. + The NR1, NR2, and NR3 formats as explained in ISO 6093 are + supported.</p> + </item> + <item> + <p>The <c>RELATIVE-OID</c> type for relative object identifiers is + fully supported.</p> + </item> + <item> + <p>The subtype constraint (<c>CONTAINING</c>/<c>ENCODED BY</c>) to + constrain the content of an octet string or a bit string is + parsed when compiling, but no further action is taken. This + constraint is not a PER-visible constraint.</p> + </item> + <item> + <p>The subtype constraint by regular expressions (<c>PATTERN</c>) + for character string types is parsed when compiling, but no + further action is taken. This constraint is not a + PER-visible constraint.</p> + </item> + <item> + <p>Multiple-line comments as in C, <c>/* ... */</c>, are + supported.</p> + </item> + </list> + </section> + + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the Erlang + programming language, concepts of OTP, and is familiar with the + ASN.1 notation. The ASN.1 notation is documented in the standard + definition X.680, which is the primary text. It can also be + helpful, but not necessary, to read the standard definitions + X.681, X.682, X.683, X.690, and X.691.</p> + <p>A good book explaining those reference texts is + Dubuisson: ASN.1 - Communication Between Heterogeneous Systems, + is free to download at + <url href="http://www.oss.com/asn1/dubuisson.html">http://www.oss.com/asn1/dubuisson.html</url>.</p> + </section> + +</chapter> + diff --git a/lib/asn1/doc/src/asn1_overview.xml b/lib/asn1/doc/src/asn1_overview.xml new file mode 100644 index 0000000000..4a10819c36 --- /dev/null +++ b/lib/asn1/doc/src/asn1_overview.xml @@ -0,0 +1,49 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>ASN.1</title> + <prepared>Kenneth Lundin</prepared> + <docno></docno> + <date>1999-03-25</date> + <rev>D</rev> + <file>asn1_overview.xml</file> + </header> + +<section> + <title>Introduction</title> + + <p>ASN.1 is a formal language for + describing data structures to be exchanged between distributed + computer systems. The purpose of ASN.1 is to have a platform + and programming language independent notation to express types + using a standardized set of rules for the transformation of + values of a defined type into a stream of bytes. This stream of + bytes can then be sent on any type of communication + channel. This way, two applications written in different + programming languages running on different computers, and with + different internal representation of data, can exchange instances + of structured data types.</p> + +</section> +</chapter> + diff --git a/lib/asn1/doc/src/asn1_spec.xmlsrc b/lib/asn1/doc/src/asn1_spec.xmlsrc index 9001aca65c..e050dff553 100644 --- a/lib/asn1/doc/src/asn1_spec.xmlsrc +++ b/lib/asn1/doc/src/asn1_spec.xmlsrc @@ -29,94 +29,100 @@ <file>asn1_spec.xml</file> </header> <marker id="SpecializedDecodes"></marker> - <p>When performance is of highest priority and one is interested in - a limited part of the ASN.1 encoded message, before one decide what - to do with the rest of it, one may want to decode only this small - part. The situation may be a server that has to decide to which - addressee it will send a message. The addressee may be interested in - the entire message, but the server may be a bottleneck that one want - to spare any unnecessary load. Instead of making two <em>complete decodes</em> (the normal case of decode), one in the server and one - in the addressee, it is only necessary to make one <em>specialized decode</em>(in the server) and another complete decode(in the - addressee). The following specialized decodes <em>exclusive decode</em> and <em>selected decode</em> support to solve this and - similar problems. - </p> - <p>So far this functionality is only provided when using the - optimized BER_BIN version, that is when compiling with the - options <c>ber_bin</c> and <c>optimize</c>. It does also work - using the <c>nif</c> option. We have no intent to make this - available on the default BER version, but maybe in the PER_BIN - version (<c>per_bin</c>). - </p> + <p>When performance is of highest priority and you are interested in + a limited part of the ASN.1 encoded message before deciding what + to do with the rest of it, an option is to decode only this small + part. The situation can be a server that has to decide the + addressee of a message. The addressee can be interested in + the entire message, but the server can be a bottleneck that you want + to spare any unnecessary load.</p> + <p> Instead of making two <em>complete decodes</em> (the normal case of + decode), one in the server and one in the addressee, it is only + necessary to make one <em>specialized decode</em>(in the server) + and another complete decode(in the addressee). This section + describes the following two specialized decodes, which support + to solve this and similar problems:</p> + <list type="bulleted"> + <item><em>Exclusive decode</em></item> + <item><em>Selected decode</em></item> + </list> + <p>This functionality is only provided when using <c>BER</c> + (option <c>ber</c>).</p> <section> <title>Exclusive Decode</title> <p>The basic idea with exclusive - decode is that you specify which parts of the message you want to + decode is to specify which parts of the message you want to exclude from being decoded. These parts remain encoded and are - returned in the value structure as binaries. They may be decoded + returned in the value structure as binaries. They can be decoded in turn by passing them to a certain <c>decode_part/2</c> - function. The performance gain is high when the message is large - and you can do an exclusive decode and later on one or several - decodes of the parts or a second complete decode instead of two or + function. The performance gain is high for large messages. + You can do an exclusive decode and later one or more + decodes of the parts, or a second complete decode instead of two or more complete decodes. </p> <section> - <title>How To Make It Work</title> - <p>In order to make exclusive decode work you have to do the - following: + <title>Procedure</title> + <p>To perform an exclusive decode: </p> <list type="bulleted"> - <item>First,decide the name of the function for the exclusive - decode.</item> - <item>Second, write instructions that must consist of the name - of the exclusive decode function, the name of the ASN.1 - specification and a notation that tells which parts of the - message structure will be excluded from decode. These - instructions shall be included in a configuration - file. </item> - <item>Third, compile with the additional option - <c>asn1config</c>. The compiler searches for a configuration - file with the same name as the ASN.1 spec but with the - extension .asn1config. This configuration file is not the same - as used for compilation of a set of files. See section - <seealso marker="#UndecodedPart">Writing an Exclusive Decode Instruction.</seealso></item> + <item><em>Step 1:</em> Decide the name of the function for the + exclusive decode.</item> + <item><p><em>Step 2:</em> Include the following instructions in + a configuration file:</p> + <list type="bulleted"> + <item>The name of the exclusive decode function</item> + <item>The name of the ASN.1 specification</item> + <item>A notation that tells which parts of the message + structure to be excluded from decode</item> + </list></item> + <item><em>Step 3</em> Compile with the additional option + <c>asn1config</c>. The compiler searches for a configuration + file with the same name as the ASN.1 specification but with + extension <c>.asn1config</c>. This configuration file is not + the same as used for compilation of a set of files. See Section + <seealso marker="#UndecodedPart">Writing an Exclusive Decode + Instruction.</seealso></item> </list> </section> <section> <title>User Interface</title> - <p>The run-time user interface for exclusive decode consists of - two different functions. First, the function for an exclusive - decode, whose name the user decides in the configuration - file. Second, the compiler generates a <c>decode_part/2</c> - function when exclusive decode is chosen. This function decodes - the parts that were left undecoded during the exclusive - decode. Both functions are described below. - </p> - <p>If the exclusive decode function has for example got the name + <p>The runtime user interface for exclusive decode consists of + the following two functions:</p> + <list type="bulleted"> + <item>A function for an exclusive decode, whose name the user + decides in the configuration file</item> + <item>The compiler generates a <c>decode_part/2</c> + function when exclusive decode is chosen. This function decodes + the parts that were left undecoded during the exclusive + decode.</item> + </list> + <p>Both functions are described in the following.</p> + <p>If the exclusive decode function has, for example, the name <c>decode_exclusive</c> and an ASN.1 encoded message - <c>Bin</c> shall be exclusive decoded, the call is:</p> + <c>Bin</c> is to be exclusive decoded, the call is as follows:</p> <pre> {ok,Excl_Message} = 'MyModule':decode_exclusive(Bin) </pre> <marker id="UndecodedPart"></marker> - <p>The result <c>Excl_Message</c> has the same structure as an - complete decode would have, except for the parts of the top-type - that were not decoded. The undecoded parts will be on their place - in the structure on the format <c>{Type_Key,Undecoded_Value}</c>. + <p>The result <c>Excl_Message</c> has the same structure as a + complete decode would have, except for the parts of the top type + that were not decoded. The undecoded parts are on their places + in the structure on format <c>{Type_Key,Undecoded_Value}</c>. </p> - <p>Each undecoded part that shall be decoded must be fed into the <c>decode_part/2</c> function,like:</p> + <p>Each undecoded part that is to be decoded must be fed into + function <c>decode_part/2</c> as follows:</p> <pre> -{ok,Part_Message} = 'MyModule':decode_part(Type_Key,Undecoded_Value) </pre> +{ok,Part_Message} = 'MyModule':decode_part(Type_Key,Undecoded_Value)</pre> </section> <section> <marker id="Exclusive Instruction"></marker> <title>Writing an Exclusive Decode Instruction</title> - <p>This instruction is written in the configuration file on the - format:</p> + <p>This instruction is written in the configuration file + in the following format:</p> <pre> - Exclusive_Decode_Instruction = {exclusive_decode,{Module_Name,Decode_Instructions}}. Module_Name = atom() @@ -137,70 +143,76 @@ Element = {Name,parts} | Top_Type = atom() -Name = atom() - </pre> - <p>Observe that the instruction must be a valid Erlang term ended - by a dot. +Name = atom()</pre> + <p>The instruction must be a valid Erlang term ended by a dot. </p> - <p>In the <c>Type_List</c> the "path" from the top type to each - undecoded sub-components is described. The top type of the path is + <p>In <c>Type_List</c> the "path" from the top type to each + undecoded subcomponents is described. The top type of the path is an atom, the name of it. The action on each component/type that - follows will be described by one of <c>{Name,parts}, {Name,undecoded}, {Name,Element_List}</c></p> - <p>The use and effect of the actions are: + follows is described by one of + <c>{Name,parts}, {Name,undecoded}, {Name,Element_List}</c>.</p> + <p>The use and effect of the actions are as follows: </p> <list type="bulleted"> - <item><c>{Name,undecoded}</c> Tells that the element will be - left undecoded during the exclusive decode. The type of Name may - be any ASN.1 type. The value of element Name will be returned as a - tuple,as mentioned <seealso marker="#UndecodedPart">above</seealso>, in the value structure of the top type.</item> - <item><c>{Name,parts}</c> The type of Name may be one of - SEQUENCE OF or SET OF. The action implies that the different - components of Name will be left undecoded. The value of Name - will be returned as a tuple, as <seealso marker="#UndecodedPart">above </seealso>, where the second element is a list of - binaries. That is because the representation of a SEQUENCE OF/ - SET OF in Erlang is a list of its internal type. Any of the - elements of this list or the entire list can be decoded by the - <c>decode_part</c> function.</item> - <item><c>{Name,Element_List}</c>This action is used when one or - more of the sub-types of Name will be exclusive decoded.</item> + <item><c>{Name,undecoded}</c> - Tells that the element is left + undecoded during the exclusive decode. The type of <c>Name</c> + can be any ASN.1 type. The value of element <c>Name</c> is + returned as a tuple (as mentioned in the previous section) in + the value structure of the top type.</item> + <item><c>{Name,parts}</c> - The type of <c>Name</c> can be one of + <c>SEQUENCE OF</c> or <c>SET OF</c>. The action implies that + the different components of <c>Name</c> are left undecoded. The + value of <c>Name</c> is returned as a tuple (as mentioned in + the previous section) where the second element is a list of + binaries. This is because the representation of a <c>SEQUENCE OF</c> + or a <c>SET OF</c> in Erlang is a list of its internal type. Any + of the elements in this list or the entire list can be decoded by + function <c>decode_part</c>.</item> + <item><c>{Name,Element_List}</c> - This action is used when one or + more of the subtypes of <c>Name</c> is exclusive decoded.</item> </list> - <p>Name in the actions above may be a component name of a - SEQUENCE or a SET or a name of an alternative in a CHOICE. + <p><c>Name</c> in these actions can be a component name of a + <c>SEQUENCE OF</c> or a <c>SET OF</c>, or a name of an alternative + in a <c>CHOICE</c>. </p> </section> <section> <title>Example</title> - <p>In the examples below we use the definitions from the following ASN.1 spec:</p> + <p>In this examples, the definitions from the following ASN.1 + specification are used:</p> <marker id="Asn1spec"></marker> <codeinclude file="Seq.asn" tag="" type="none"></codeinclude> - <p>If <c>Button</c> is a top type and we want to exclude - component <c>number</c> from decode the Type_List in the - instruction in the configuration file will be - <c>['Button',[{number,undecoded}]]</c>. If we call the decode - function <c>decode_Button_exclusive</c> the Decode_Instruction - will be + <p>If <c>Button</c> is a top type and it is needed to exclude + component <c>number</c> from decode, <c>Type_List</c> in the + instruction in the configuration file is + <c>['Button',[{number,undecoded}]]</c>. If you call the decode + function <c>decode_Button_exclusive</c>, <c>Decode_Instruction</c> is <c>{decode_Button_exclusive,['Button',[{number,undecoded}]]}</c>. </p> - <p>We also have another top type <c>Window</c> whose sub - component actions in type <c>Status</c> and the parts of component - <c>buttonList</c> shall be left undecoded. For this type we name - the function <c>decode__Window_exclusive</c>. The whole - Exclusive_Decode_Instruction configuration is as follows: </p> + <p>Another top type is <c>Window</c> whose subcomponent + actions in type <c>Status</c> and the parts of component + <c>buttonList</c> are to be left undecoded. For this type, the + function is named <c>decode__Window_exclusive</c>. The complete + <c>Exclusive_Decode_Instruction</c> configuration is as follows:</p> <codeinclude file="Seq.asn1config" tag="" type="none"></codeinclude> + <p>The following figure shows the bytes of a <c>Window:status</c> + message. The components <c>buttonList</c> and <c>actions</c> are + excluded from decode. Only <c>state</c> and <c>enabled</c> are decoded + when <c>decode__Window_exclusive</c> is called.</p> <p></p> <image file="exclusive_Win_But.gif"> - <icaption>Figure symbolizes the bytes of a Window:status message. The components buttonList and actions are excluded from decode. Only state and enabled are decoded when decode__Window_exclusive is called. </icaption> + <icaption>Bytes of a Window:status Message</icaption> </image> <p></p> - <p>Compiling GUI.asn including the configuration file is done like:</p> + <p>Compiling <c>GUI.asn</c> including the configuration file is done + as follows:</p> <pre> -unix> erlc -bber_bin +optimize +asn1config GUI.asn +unix> erlc -bber +asn1config GUI.asn -erlang> asn1ct:compile('GUI',[ber_bin,optimize,asn1config]). </pre> - <p>The module can be used like:</p> +erlang> asn1ct:compile('GUI', [ber,asn1config]).</pre> + <p>The module can be used as follows:</p> <pre> - 1> Button_Msg = {'Button',123,true}. {'Button',123,true} 2> {ok,Button_Bytes} = 'GUI':encode('Button',Button_Msg). @@ -289,35 +301,39 @@ BoolOpt,{Type_Key_Choice,Val_Choice}}}}= 11> 'GUI':decode_part(Type_Key_SeqOf,hd(Val_SEQOF)). {ok,{'Button',3,true}} 12> 'GUI':decode_part(Type_Key_Choice,Val_Choice). -{ok,{possibleActions,[{'Action',16,{'Button',17,true}}]}} - </pre> +{ok,{possibleActions,[{'Action',16,{'Button',17,true}}]}}</pre> </section> </section> <section> <title>Selective Decode</title> - <p>This specialized decode decodes one single subtype of a - constructed value. It is the fastest method to extract one sub - value. The typical use of this decode is when one want to - inspect, for instance a version number,to be able to decide what + <p>This specialized decode decodes a subtype of a + constructed value and is the fastest method to extract a + subvalue. This decode is typically used when you want to + inspect, for example, a version number, to be able to decide what to do with the entire value. The result is returned as <c>{ok,Value}</c> or <c>{error,Reason}</c>. </p> <section> - <title>How To Make It Work</title> - <p>The following steps are necessary: + <title>Procedure</title> + <p>To perform a selective decode: </p> <list type="bulleted"> - <item>Write instructions in the configuration - file. Including the name of a user function, the name of the ASN.1 - specification and a notation that tells which part of the type - will be decoded. </item> - <item>Compile with the additional option - <c>asn1config</c>. The compiler searches for a configuration file - with the same name as the ASN.1 spec but with the extension - .asn1config. In the same file you can provide configuration specs - for exclusive decode as well. The generated Erlang module has the + <item><p><em>Step 1:</em> Include the following instructions in + the configuration file:</p> + <list type="bulleted"> + <item>The name of the user function</item> + <item>The name of the ASN.1 specification</item> + <item>A notation that tells which part of the type to be + decoded</item> + </list></item> + <item><em>Step 2:</em> Compile with the additional option + <c>asn1config</c>. The compiler searches for a configuration file + with the same name as the ASN.1 specification, but with extension + <c>.asn1config</c>. In the same file you can also provide + configuration specifications for exclusive decode. + The generated Erlang module has the usual functionality for encode/decode preserved and the specialized decode functionality added. </item> </list> @@ -326,21 +342,20 @@ BoolOpt,{Type_Key_Choice,Val_Choice}}}}= <section> <title>User Interface</title> <p>The only new user interface function is the one provided by the - user in the configuration file. You can invoke that function by + user in the configuration file. The function is started by the <c>ModuleName:FunctionName</c> notation. </p> - <p>So, if you have the following spec + <p>For example, if the configuration file includes the specification <c>{selective_decode,{'ModuleName',[{selected_decode_Window,TypeList}]}}</c> - in the con-fig file, you do the selective decode by + do the selective decode by <c>{ok,Result}='ModuleName':selected_decode_Window(EncodedBinary).</c></p> </section> <section> <marker id="Selective Instruction"></marker> <title>Writing a Selective Decode Instruction</title> - <p>It is possible to describe one or many selective decode - functions in a configuration file, you have to use the following - notation:</p> + <p>One or more selective decode functions can be described in a + configuration file. Use the following notation:</p> <pre> Selective_Decode_Instruction = {selective_decode,{Module_Name,Decode_Instructions}}. @@ -358,37 +373,43 @@ Element_List = Name|List_Selector Name = atom() -List_Selector = [integer()] </pre> - <p>Observe that the instruction must be a valid Erlang term ended - by a dot. - </p> - <p>The <c>Module_Name</c> is the same as the name of the ASN.1 - spec, but without the extension. A <c>Decode_Instruction</c> is - a tuple with your chosen function name and the components from - the top type that leads to the single type you want to - decode. Notice that you have to choose a name of your function - that will not be the same as any of the generated functions. The - first element of the <c>Type_List</c> is the top type of the - encoded message. In the <c>Element_List</c> it is followed by - each of the component names that leads to selected type. Each of - the names in the <c>Element_List</c> must be constructed types - except the last name, which can be any type. +List_Selector = [integer()]</pre> + <p>The instruction must be a valid Erlang term ended by a dot. </p> - <p>The List_Selector makes it possible to choose one of the - encoded components in a SEQUENCE OF/ SET OF. It is also possible - to go further in that component and pick a sub type of that to - decode. So in the <c>Type_List</c>: <c>['Window',status,buttonList,[1],number]</c> the - component <c>buttonList</c> has to be a SEQUENCE OF or SET OF type. In - this example component <c>number</c> of the first of the encoded - elements in the SEQUENCE OF <c>buttonList</c> is selected. This apply on - the ASN.1 spec <seealso marker="#Asn1spec">above</seealso>. + <list type="bulleted"> + <item><c>Module_Name</c> is the same as the name of the ASN.1 + specification, but without the extension.</item> + <item><c>Decode_Instruction</c> is a tuple with your chosen + function name and the components from the top type that leads + to the single type you want to decode. Ensure to choose a name + of your function that is not the same as any of the generated + functions.</item> + <item> The first element of <c>Type_List</c> is the top type of the + encoded message. In <c>Element_List</c>, it is followed by + each of the component names that leads to selected type.</item> + <item>Each name in <c>Element_List</c> must be a constructed type + except the last name, which can be any type.</item> + <item><c>List_Selector</c> makes it possible to choose one of the + encoded components in a a <c>SEQUENCE OF</c> or a <c>SET OF</c>. + It is also possible to go further in that component and pick a + subtype of that to decode. So, in the <c>Type_List</c>: + <c>['Window',status,buttonList,[1],number]</c>, component + <c>buttonList</c> must be of type <c>SEQUENCE OF</c> or + <c>SET OF</c>.</item> + </list> + <p>In the example, component <c>number</c> of the first of the encoded + elements in the <c>SEQUENCE OF</c> <c>buttonList</c> is selected. + This applies on the ASN.1 specification in Section + <seealso marker="#Asn1spec">Writing an Exclusive Decode + Instruction</seealso>. </p> </section> <section> <title>Another Example</title> - <p>In this example we use the same ASN.1 spec as <seealso marker="#Asn1spec">above</seealso>. A valid selective decode - instruction is:</p> + <p>In this example, the same ASN.1 specification as in Section + <seealso marker="#Asn1spec">Writing an Exclusive Decode Instruction</seealso> + is used. The following is a valid selective decode instruction:</p> <pre> {selective_decode, {'GUI', @@ -404,16 +425,17 @@ List_Selector = [integer()] </pre> actions, possibleActions, [1], - handle,number]}]}}. - </pre> - <p>The first <c>Decode_Instruction</c>, + handle,number]}]}}.</pre> + <p>The first instruction, <c>{selected_decode_Window1,['Window',status,buttonList,[1],number]}</c> - is commented in the previous section. The instruction - <c>{selected_decode_Action,['Action',handle,number]}</c> picks - the component <c>number</c> in the <c>handle</c> component of the type - <c>Action</c>. If we have the value <c>ValAction = {'Action',17,{'Button',4711,false}}</c> the internal value 4711 - should be picked by <c>selected_decode_Action</c>. In an Erlang - terminal it looks like:</p> + is described in the previous section.</p> + <p> The second instruction, + <c>{selected_decode_Action,['Action',handle,number]}</c>, takes + component <c>number</c> in the <c>handle</c> component of type + <c>Action</c>. If the value is + <c>ValAction = {'Action',17,{'Button',4711,false}}</c>, the internal + value 4711 is to be picked by <c>selected_decode_Action</c>. In an + Erlang terminal it looks as follows:</p> <pre> ValAction = {'Action',17,{'Button',4711,false}}. {'Action',17,{'Button',4711,false}} @@ -423,44 +445,41 @@ ValAction = {'Action',17,{'Button',4711,false}}. <<48,18,2,1,17,160,13,172,11,171,9,48,7,128,2,18,103,129,1,0>> 9> 'GUI':selected_decode_Action(BinBytes). {ok,4711} -10> </pre> +10></pre> <p>The third instruction, <c>['Window',status,actions,possibleActions,[1],handle,number]</c>, - which is a little more complicated,</p> + works as follows:</p> <list type="bulleted"> - <item>starts with type <em>Window</em>. </item> - <item>Picks component <em>status</em> of <c>Window</c> that is - of type <c>Status</c>.</item> - <item>Then takes component <em>actions</em> of type + <item><em>Step 1:</em> Starts with type <c>Window</c>.</item> + <item><em>Step 2:</em> Takes component <c>status</c> of <c>Window</c> + that is of type <c>Status</c>.</item> + <item><em>Step 3:</em> Takes <em>actions</em> of type <c>Status</c>.</item> - <item>Then <em>possibleActions</em> of the internal defined - CHOICE type.</item> - <item>Thereafter it goes into the first component of the - SEQUENCE OF by <em>[1]</em>. That component is of type - <c>Action</c>.</item> - <item>The instruction next picks component - <em>handle</em>.</item> - <item>And finally component <em>number</em> of the type + <item><em>Step 4:</em> Takes <c>possibleActions</c> of the internally + defined <c>CHOICE</c> type.</item> + <item><em>Step 5:</em> Goes into the first component of + <c>SEQUENCE OF</c> by <c>[1]</c>. That component is of type + <c>Action</c>.</item> + <item><em>Step 6:</em> Takes component <c>handle</c>.</item> + <item><em>Step 7:</em> Takes component <c>number</c> of type <c>Button</c>.</item> </list> - <p>The following figures shows which components are in the - TypeList - <c>['Window',status,actions,possibleActions,[1],handle,number]</c>. And - which part of a message that will be decoded by - selected_decode_Window2. - </p> + <p>The following figure shows which components are in <c>TypeList</c> + <c>['Window',status,actions,possibleActions,[1],handle,number]</c>:</p> <p></p> <image file="selective_TypeList.gif"> - <icaption>The elements specified in the config file for selective decode of a sub-value in a Window message</icaption> + <icaption>Elements Specified in Configuration File for Selective Decode of a Subvalue in a Window Message</icaption> </image> + <p>In the following figure, only the marked element is decoded by + <c>selected_decode_Window2</c>:</p> <p></p> <image file="selective_Window2.gif"> - <icaption>Figure symbolizes the bytes of a Window:status message. Only the marked element is decoded when selected_decode_Window2 is called. </icaption> + <icaption>Bytes of a Window:status Message</icaption> </image> - <p>With the following example you can examine that both + <p>With the following example, you can examine that both <c>selected_decode_Window2</c> and - <c>selected_decode_Window1</c> decodes the intended sub-value - of the value <c>Val</c></p> + <c>selected_decode_Window1</c> decodes the intended subvalue + of value <c>Val</c>:</p> <pre> 1> Val = {'Window',{status,{'Status',12, [{'Button',13,true}, @@ -478,8 +497,8 @@ ValAction = {'Action',17,{'Button',4711,false}}. 4> 'GUI':selected_decode_Window1(Bin). {ok,13} 5> 'GUI':selected_decode_Window2(Bin). -{ok,18} </pre> - <p>Observe that the value feed into the selective decode +{ok,18}</pre> + <p>Notice that the value fed into the selective decode functions must be a binary. </p> </section> @@ -489,19 +508,19 @@ ValAction = {'Action',17,{'Button',4711,false}}. <title>Performance</title> <p>To give an indication on the possible performance gain using the specialized decodes, some measures have been performed. The - relative figures in the outcome between selective, exclusive and - complete decode (the normal case) depends on the structure of - the type, the size of the message and on what level the + relative figures in the outcome between selective, exclusive, and + complete decode (the normal case) depend on the structure of + the type, the size of the message, and on what level the selective and exclusive decodes are specified. </p> <section> - <title>ASN.1 Specifications, Messages and Configuration</title> - <p>The specs <seealso marker="#Asn1spec">GUI</seealso> and + <title>ASN.1 Specifications, Messages, and Configuration</title> + <p>The specifications <seealso marker="#Asn1spec">GUI</seealso> and <url href="http://www.itu.int/ITU-T/asn1/database/itu-t/h/h248/2002/MEDIA-GATEWAY-CONTROL.html">MEDIA-GATEWAY-CONTROL</url> - was used in the test. + were used in the test. </p> - <p>For the GUI spec the configuration looked like:</p> + <p>For the <c>GUI</c> specification the configuration was as follows:</p> <pre> {selective_decode, {'GUI', @@ -523,9 +542,8 @@ ValAction = {'Action',17,{'Button',4711,false}}. ['Window', [{status, [{buttonList,parts}, - {actions,undecoded}]}]]}]}}. - </pre> - <p>The MEDIA-GATEWAY-CONTROL configuration was:</p> + {actions,undecoded}]}]]}]}}.</pre> + <p>The <c>MEDIA-GATEWAY-CONTROL</c> configuration was as follows:</p> <pre> {exclusive_decode, {'MEDIA-GATEWAY-CONTROL', @@ -538,9 +556,8 @@ ValAction = {'Action',17,{'Button',4711,false}}. {selective_decode, {'MEDIA-GATEWAY-CONTROL', [{decode_MegacoMessage_selective, - ['MegacoMessage',mess,version]}]}}. - </pre> - <p>The corresponding values were:</p> + ['MegacoMessage',mess,version]}]}}.</pre> + <p>The corresponding values were as follows:</p> <pre> {'Window',{status,{'Status',12, [{'Button',13,true}, @@ -649,177 +666,178 @@ ValAction = {'Action',17,{'Button',4711,false}}. {'StatisticsParameter',[0,11,0,3],[[52,53,49,48,48]]}, {'StatisticsParameter',[0,12,0,6],[[48,46,50]]}, {'StatisticsParameter',[0,12,0,7],[[50,48]]}, - {'StatisticsParameter',[0,12,0,8],[[52,48]]}]}]}}}]}]}}}]}}} - </pre> - <p>The size of the encoded values was 458 bytes for GUI and 464 - bytes for MEDIA-GATEWAY-CONTROL. + {'StatisticsParameter',[0,12,0,8],[[52,48]]}]}]}}}]}]}}}]}}}</pre> + <p>The size of the encoded values was 458 bytes for <c>GUI</c> and 464 + bytes for <c>MEDIA-GATEWAY-CONTROL</c>. </p> </section> <section> <title>Results</title> - <p>The ASN.1 specs in the test are compiled with the options - <c>ber_bin, optimize, driver</c> and <c>asn1config</c>. If the - <c>driver</c> option had been omitted there should have been + <p>The ASN.1 specifications in the test were compiled with options + <c>ber_bin, optimize, driver</c> and <c>asn1config</c>. Omitting + option <c>driver</c> gives higher values for <c>decode</c> and <c>decode_part</c>. These tests have - not been re-run using nifs, but are expected to perform about 5% better + not been rerun using NIFs, but are expected to perform about 5% better than the linked-in driver. </p> <p>The test program runs 10000 decodes on the value, resulting - in a printout with the elapsed time in microseconds for the + in an output with the elapsed time in microseconds for the total number of decodes. </p> <table> <row> <cell align="left" valign="top"><em>Function</em></cell> - <cell align="left" valign="top"><em>Time</em>(microseconds)</cell> - <cell align="left" valign="top"><em>Kind of Decode</em></cell> - <cell align="left" valign="top"><em>ASN.1 spec</em></cell> - <cell align="left" valign="top"><em>% of time vs. complete decode</em></cell> + <cell align="left" valign="top"><em>Time</em> (microseconds)</cell> + <cell align="left" valign="top"><em>Decode Type</em></cell> + <cell align="left" valign="top"><em>ASN.1 Specification</em></cell> + <cell align="left" valign="top"><em>% of Time versus Complete Decode</em></cell> </row> <row> <cell align="left" valign="middle"><c>decode_MegacoMessage_selective/1</c></cell> <cell align="left" valign="middle"><c>374045</c></cell> - <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>Selective</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>8.3</em></cell> </row> <row> <cell align="left" valign="middle"><c>decode_MegacoMessage_exclusive/1</c></cell> <cell align="left" valign="middle"><c>621107</c></cell> - <cell align="left" valign="middle"><c>exclusive</c></cell> + <cell align="left" valign="middle"><c>Exclusive</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>13.8</em></cell> </row> <row> <cell align="left" valign="middle"><c>decode/2</c></cell> <cell align="left" valign="middle"><c>4507457</c></cell> - <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>Complete</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>100</em></cell> </row> <row> <cell align="left" valign="middle"><c>selected_decode_Window1/1</c></cell> <cell align="left" valign="middle"><c>449585</c></cell> - <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>Selective</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>7.6</em></cell> </row> <row> <cell align="left" valign="middle"><c>selected_decode_Window2/1</c></cell> <cell align="left" valign="middle"><c>890666</c></cell> - <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>Selective</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>15.1</em></cell> </row> <row> <cell align="left" valign="middle"><c>decode_Window_status_exclusive/1</c></cell> <cell align="left" valign="middle"><c>1251878</c></cell> - <cell align="left" valign="middle"><c>exclusive</c></cell> + <cell align="left" valign="middle"><c>Exclusive</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>21.3</em></cell> </row> <row> <cell align="left" valign="middle"><c>decode/2</c></cell> <cell align="left" valign="middle"><c>5889197</c></cell> - <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>Complete</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>100</em></cell> </row> - <tcaption>Results of complete, exclusive and selective decode</tcaption> + <tcaption>Results of Complete, Exclusive, and Selective Decode</tcaption> </table> - <p>Another interesting question is what the relation is between + <p>It is also of interest to know the relation is between a complete decode, an exclusive decode followed by - <c>decode_part</c> of the excluded parts and a selective decode - followed by a complete decode. Some situations may be compared to - this simulation, e.g. inspect a sub-value and later on look at + <c>decode_part</c> of the excluded parts, and a selective decode + followed by a complete decode. Some situations can be compared to + this simulation, for example, inspect a subvalue and later inspect the entire value. The following table shows figures from this - test. The number of loops and time unit is the same as in the + test. The number of loops and the time unit are the same as in the previous test. </p> <table> <row> <cell align="left" valign="top"><em>Actions</em></cell> <cell align="left" valign="top"><em>Function</em> </cell> - <cell align="left" valign="top"><em>Time</em>(microseconds)</cell> - <cell align="left" valign="top"><em>ASN.1 spec</em></cell> - <cell align="left" valign="top"><em>% of time vs. complete decode</em></cell> + <cell align="left" valign="top"><em>Time</em> (microseconds)</cell> + <cell align="left" valign="top"><em>ASN.1 Specification</em></cell> + <cell align="left" valign="top"><em>% of Time vs. Complete Decode</em></cell> </row> <row> - <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>Complete</c></cell> <cell align="left" valign="middle"><c>decode/2</c></cell> <cell align="left" valign="middle"><c>4507457</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>100</em></cell> </row> <row> - <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>Selective and Complete</c></cell> <cell align="left" valign="middle"><c>decode_­MegacoMessage_­selective/1</c></cell> <cell align="left" valign="middle"><c>4881502</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>108.3</em></cell> </row> <row> - <cell align="left" valign="middle"><c>exclusive and decode_part</c></cell> + <cell align="left" valign="middle"><c>Exclusive and decode_part</c></cell> <cell align="left" valign="middle"><c>decode_­MegacoMessage_­exclusive/1</c></cell> <cell align="left" valign="middle"><c>5481034</c></cell> <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> <cell align="left" valign="middle"><em>112.3</em></cell> </row> <row> - <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>Complete</c></cell> <cell align="left" valign="middle"><c>decode/2</c></cell> <cell align="left" valign="middle"><c>5889197</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>100</em></cell> </row> <row> - <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>Selective and Complete</c></cell> <cell align="left" valign="middle"><c>selected_­decode_­Window1/1</c></cell> <cell align="left" valign="middle"><c>6337636</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>107.6</em></cell> </row> <row> - <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>Selective and Complete</c></cell> <cell align="left" valign="middle"><c>selected_­decode_­Window2/1</c></cell> <cell align="left" valign="middle"><c>6795319</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>115.4</em></cell> </row> <row> - <cell align="left" valign="middle"><c>exclusive and decode_part</c></cell> + <cell align="left" valign="middle"><c>Exclusive and decode_part</c></cell> <cell align="left" valign="middle"><c>decode_­Window_­status_­exclusive/1</c></cell> <cell align="left" valign="middle"><c>6249200</c></cell> <cell align="left" valign="middle"><c>GUI</c></cell> <cell align="left" valign="middle"><em>106.1</em></cell> </row> - <tcaption>Results of complete, exclusive + decode_part and selective + complete decodes</tcaption> + <tcaption>Results of Complete, Exclusive + decode_part, and Selective + complete decodes</tcaption> </table> <p>Other ASN.1 types and values can differ much from these - figures. Therefore it is important that you, in every case where + figures. It is therefore important that you, in every case where you intend to use either of these decodes, perform some tests - that shows if you will benefit your purpose. + that show if you will benefit your purpose. </p> </section> <section> - <title>Comments</title> - <p>Generally speaking the gain of selective and exclusive decode - in advance of complete decode is greater the bigger value and the - less deep in the structure you have to decode. One should also - prefer selective decode instead of exclusive decode if you are - interested in just one single sub-value.</p> - <p>Another observation is that the exclusive decode followed by - decode_part decodes is very attractive if the parts will be sent - to different servers for decoding or if one in some cases not is - interested in all parts.</p> - <p>The fastest selective decode are when the decoded type is a + <title>Final Remarks</title> + <list type="bulleted"> + <item>The gain of using selective and exclusive decode instead of a + complete decode is greater the bigger the value and the + less deep in the structure you have to decode.</item> + <item>Use selective decode instead of exclusive decode if you are + interested in only a single subvalue.</item> + <item>Exclusive decode followed by + <c>decode_part</c> decodes is attractive if the parts are sent + to different servers for decoding, or if you in some cases are not + interested in all parts.</item> + <item>The fastest selective decode is when the decoded type is a primitive type and not so deep in the structure of the top - type. The <c>selected_decode_Window2</c> decodes a big constructed - value, which explains why this operation is relatively slow.</p> - <p>It may vary from case to case which combination of - selective/complete decode or exclusive/part decode is the fastest.</p> + type. <c>selected_decode_Window2</c> decodes a high constructed + value, which explains why this operation is relatively slow.</item> + <item>It can vary from case to case which combination of + selective/complete decode or exclusive/part decode is the fastest.</item> + </list> </section> </section> </chapter> diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml deleted file mode 100644 index 8b33497dd3..0000000000 --- a/lib/asn1/doc/src/asn1_ug.xml +++ /dev/null @@ -1,1417 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1997</year><year>2013</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - - </legalnotice> - - <title>Asn1</title> - <prepared>Kenneth Lundin</prepared> - <docno></docno> - <date>1999-03-25</date> - <rev>D</rev> - <file>asn1_ug.xml</file> - </header> - - <section> - <title>Introduction</title> - - <section> - <title>Features</title> - <p>The Asn1 application provides:</p> - <list type="bulleted"> - <item>An ASN.1 compiler for Erlang, which generates encode and - decode functions to be used by Erlang programs sending and - receiving ASN.1 specified data.</item> - <item>Run-time functions used by the generated code.</item> - <item>Support for the following encoding rules: - <list> - <item> - Basic Encoding Rules (<em>BER</em>) - </item> - <item> - Distinguished Encoding Rules (<em>DER</em>), a specialized - form of BER that is used in security-conscious - applications. - </item> - <item> - Packed Encoding Rules (<em>PER</em>); both the aligned and - unaligned variant. - </item> - </list> - </item> - </list> - </section> - - <section> - <title>Overview</title> - <p>ASN.1 (Abstract Syntax Notation One) is a formal language for - describing data structures to be exchanged between distributed - computer systems. The purpose of ASN.1 is to have a platform - and programming language independent notation to express types - using a standardized set of rules for the transformation of - values of a defined type into a stream of bytes. This stream of - bytes can then be sent on any type of communication - channel. This way, two applications written in different - programming languages running on different computers with - different internal representation of data can exchange instances - of structured data types.</p> - </section> - - <section> - <title>Prerequisites</title> - <p>It is assumed that the reader is familiar with the ASN.1 - notation as documented in the standard definition [<cite - id="X.680"></cite>] which is the primary text. It may also be - helpful, but not necessary, to read the standard definitions - [<cite id="X.681"></cite>] [<cite id="X.682"></cite>] [<cite - id="X.683"></cite>] [<cite id="X.690"></cite>] [<cite - id="X.691"></cite>]. </p> - <p>A good book explaining those reference texts is - [<cite id="DUBUISSON"></cite>], which is free to download at - <url href="http://www.oss.com/asn1/dubuisson.html">http://www.oss.com/asn1/dubuisson.html</url>. - </p> - </section> - - <section> - <title>Capabilities</title> - <p>This application covers all features of ASN.1 up to the 1997 - edition of the specification. In the 2002 edition of ASN.1 a - number of new features were introduced. The following features - of the 2002 edition are fully or partly supported as shown - below:</p> - <list type="bulleted"> - <item> - <p>Decimal notation (e.g., "1.5e3") for REAL values. The - NR1, NR2 and NR3 formats as explained in ISO6093 are - supported.</p> - </item> - <item> - <p>The RELATIVE-OID type for relative object identifiers is - fully supported.</p> - </item> - <item> - <p>The subtype constraint (CONTAINING/ENCODED BY) to - constrain the content of an octet string or a bit string is - parsed when compiling, but no further action is taken. This - constraint is not a PER-visible constraint.</p> - </item> - <item> - <p>The subtype constraint by regular expressions (PATTERN) - for character string types is parsed when compiling, but no - further action is taken. This constraint is not a - PER-visible constraint.</p> - </item> - <item> - <p>Multiple-line comments as in C, <c>/* ... */</c>, are - supported.</p> - </item> - </list> - </section> - - </section> - - <section> - <title>Getting Started with Asn1</title> - - <section> - <title>A First Example</title> - <p>The following example demonstrates the basic functionality used to run - the Erlang ASN.1 compiler.</p> - <p>Create a file called <c>People.asn</c> containing the following:</p> - <pre> -People DEFINITIONS AUTOMATIC TAGS ::= -BEGIN - Person ::= SEQUENCE { - name PrintableString, - location INTEGER {home(0),field(1),roving(2)}, - age INTEGER OPTIONAL - } -END </pre> - <p>This file (<c>People.asn</c>) must be compiled before it can be - used. - The ASN.1 compiler checks that the syntax is correct and that the - text represents proper ASN.1 code before generating an abstract - syntax tree. The code-generator then uses the abstract syntax - tree in order to generate code. - </p> - <p>The generated Erlang files will be placed in the current directory or - in the directory specified with the <c>{outdir,Dir}</c> option. - The following shows how the compiler - can be called from the Erlang shell:</p> - <pre> -1><input> asn1ct:compile("People", [ber]).</input> -ok -2> </pre> - - <p>The <c>verbose</c> option can be given to have information - about the generated files printed:</p> - <pre> -2><input> asn1ct:compile("People", [ber,verbose]).</input> -Erlang ASN.1 compiling "People.asn" ---{generated,"People.asn1db"}-- ---{generated,"People.hrl"}-- ---{generated,"People.erl"}-- -ok -3> </pre> - - <p>The ASN.1 module <c>People</c> is now accepted and the - abstract syntax tree is saved in the <c>People.asn1db</c> file; - the generated Erlang code is compiled using the Erlang compiler - and loaded into the Erlang run-time system. Now there is an API - for <c>encode/2</c> and <c>decode/2</c> in the module - <c>People</c>, which is invoked by: <br></br> - <c><![CDATA['People':encode(<Type name>, <Value>)]]></c> - <br></br> - or <br></br> -<c><![CDATA['People':decode(<Type name>, <Value>)]]></c></p> - - <p>Assume there is a network - application which receives instances of the ASN.1 defined - type Person, modifies and sends them back again:</p> - <code type="none"> -receive - {Port,{data,Bytes}} -> - case 'People':decode('Person',Bytes) of - {ok,P} -> - {ok,Answer} = 'People':encode('Person',mk_answer(P)), - Port ! {self(),{command,Answer}}; - {error,Reason} -> - exit({error,Reason}) - end - end, </code> - <p>In the example above, a series of bytes is received from an - external source and the bytes are then decoded into a valid - Erlang term. This was achieved with the call - <c>'People':decode('Person',Bytes)</c> which returned - an Erlang value of the ASN.1 type <c>Person</c>. Then an answer was - constructed and encoded using - <c>'People':encode('Person',Answer)</c> which takes an - instance of a defined ASN.1 type and transforms it to a - binary according to the BER or PER encoding rules. - <br></br> -The encoder and the decoder can also be run from - the shell.</p> - <pre> -2> <input>Rockstar = {'Person',"Some Name",roving,50}.</input> -{'Person',"Some Name",roving,50} -3> <input>{ok,Bin} = 'People':encode('Person',Rockstar).</input> -{ok,<<243,17,19,9,83,111,109,101,32,78,97,109,101,2,1,2, - 2,1,50>>} -4> <input>{ok,Person} = 'People':decode('Person',Bin).</input> -{ok,{'Person',"Some Name",roving,50}} -5> </pre> - </section> - - <section> - <title>Module dependencies</title> - <p>It is common that ASN.1 modules import defined types, values and - other entities from another ASN.1 module.</p> - <p>Earlier versions of the ASN.1 compiler required that modules that - were imported from had to be compiled before the module that - imported. This caused problems when ASN.1 modules had circular - dependencies.</p> - <p>Referenced modules are now parsed when the compiler finds an - entity that is imported. There will not be any code generated for - the referenced module. However, the compiled module rely on - that the referenced modules also will be compiled.</p> - </section> - </section> - - <section> - <title>The Asn1 Application User Interface</title> - <p>The Asn1 application provides two separate user interfaces:</p> - <list type="bulleted"> - <item> - <p>The module <c>asn1ct</c> which provides the compile-time functions - (including the compiler).</p> - </item> - <item> - <p>The module <c>asn1rt_nif</c> which provides the run-time functions - for the ASN.1 decoder for the BER back-end.</p> - </item> - </list> - <p>The reason for the division of the interface into compile-time - and run-time - is that only run-time modules (<c>asn1rt*</c>) need to be loaded in - an embedded system. - </p> - - <section> - <title>Compile-time Functions</title> - <p>The ASN.1 compiler can be invoked directly from the command-line - by means of the <c>erlc</c> program. This is convenient when compiling - many ASN.1 files from the command-line or when using Makefiles. - Here are some examples of how the <c>erlc</c> command can be used to invoke the - ASN.1 compiler:</p> - <pre> -erlc Person.asn -erlc -bper Person.asn -erlc -bber ../Example.asn -erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </pre> - <p>The useful options for the ASN.1 compiler are:</p> - <taglist> - <tag><c>-b[ber | per | uper]</c></tag> - <item> - <p>Choice of encoding rules, if omitted <c>ber</c> is the - default.</p> - </item> - <tag><c>-o OutDirectory</c></tag> - <item> - <p>Where to put the generated files, default is the current - directory.</p> - </item> - <tag><c>-I IncludeDir</c></tag> - <item> - <p>Where to search for <c>.asn1db</c> files and ASN.1 - source specs in order to resolve references to other - modules. This option can be repeated many times if there - are several places to search in. The compiler will always - search the current directory first.</p> - </item> - <tag><c>+der</c></tag> - <item> - <p>DER encoding rule. Only when using <c>-ber</c> option.</p> - </item> - <tag><c>+asn1config</c></tag> - <item> - <p>This functionality works together with the - <c>ber</c> option. It enables the - specialized decodes, see the <seealso marker="asn1_spec">Specialized Decode</seealso> chapter. - </p> - </item> - <tag><c>+undec_rest</c></tag> - <item> - <p>A buffer that holds a message being decoded may also have - trailing bytes. If those trailing bytes are important they - can be returned along with the decoded value by compiling - the ASN.1 specification with the <c>+undec_rest</c> option. - The return value from the decoder will be - <c>{ok,Value,Rest}</c> where <c>Rest</c> is a binary - containing the trailing bytes.</p> - </item> - <tag><c>+'Any Erlc Option'</c></tag> - <item> - <p>You may add any option to the Erlang compiler when - compiling the generated Erlang files. Any option - unrecognized by the ASN.1 compiler will be passed to the - Erlang compiler.</p> - </item> - </taglist> - <p>For a complete description of <c>erlc</c> see Erts Reference Manual.</p> - <p>The compiler and other compile-time functions can also be invoked from - the Erlang shell. Below follows a brief - description of the primary functions, for a - complete description of each function see - <seealso marker="asn1ct">the Asn1 Reference Manual</seealso>, the - <c>asn1ct</c> module.</p> - <p>The compiler is invoked by using <c>asn1ct:compile/1</c> with - default options, or <c>asn1ct:compile/2</c> if explicit options - are given. - Example:</p> - <pre> -asn1ct:compile("H323-MESSAGES.asn1"). </pre> - <p>which equals:</p> - <pre> -asn1ct:compile("H323-MESSAGES.asn1",[ber]). </pre> - <p>If one wants PER encoding:</p> - <pre> -asn1ct:compile("H323-MESSAGES.asn1",[per]). </pre> - <p>The generic encode and decode functions can be invoked like this:</p> - <pre> -'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). -'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> - </section> - - <section> - <title>Run-time Functions</title> - <p>When an ASN.1 specification is compiled with the <c>ber</c> - option, the module <c>asn1rt_nif</c> module and the NIF library in - <c>asn1/priv_dir</c> will be needed at run-time.</p> - <p>By invoking the function <c>info/0</c> in a generated module, one - gets information about which compiler options were used.</p> - </section> - - <section> - <title>Errors</title> - <p>Errors detected at - compile time appear on the screen together with - a line number indicating where in the source file the error - was detected. If no errors are found, an Erlang ASN.1 module will - be created.</p> - <p>The run-time encoders and decoders execute within a catch and - returns <c>{ok, Data}</c> or - <c>{error, {asn1, Description}}</c> where - <c>Description</c> is - an Erlang term describing the error. </p> - </section> - </section> - - <section> - <marker id="inlineExamples"></marker> - <title>Multi-file Compilation</title> - <p>There are various reasons for using multi-file compilation:</p> - <list type="bulleted"> - <item>You want to choose the name for the generated module, - perhaps because you need to compile the same specs for - different encoding rules.</item> - <item>You want only one resulting module.</item> - </list> - <p>You need to specify which ASN.1 specs you will - compile in a module that must have the extension - <c>.set.asn</c>. You chose name of the module and provide the - names of the ASN.1 specs. For instance, if you have the specs - <c>File1.asn</c>, <c>File2.asn</c> and <c>File3.asn</c> your - module <c>MyModule.set.asn</c> will look like:</p> - <pre> -File1.asn -File2.asn -File3.asn </pre> - <p>If you compile with:</p> - <code type="none"> -~> erlc MyModule.set.asn </code> - <p>the result will be one merged module <c>MyModule.erl</c> with - the generated code from the three ASN.1 specs. - </p> - </section> - - <section> - <title>A quick note about tags</title> - - <p>Tags used to be important for all users of ASN.1, because it - was necessary to manually add tags to certain constructs in order - for the ASN.1 specification to be valid. Here is an example of - an old-style specification:</p> - - <pre> -Tags DEFINITIONS ::= -BEGIN - Afters ::= CHOICE { cheese [0] IA5String, - dessert [1] IA5String } -END </pre> - - <p>Without the tags (the numbers in square brackets) the ASN.1 - compiler would refuse to compile the file.</p> - - <p>In 1994 the global tagging mode AUTOMATIC TAGS was introduced. - By putting AUTOMATIC TAGS in the module header, the ASN.1 compiler - will automatically add tags when needed. Here is the same - specification in AUTOMATIC TAGS mode:</p> - - <pre> -Tags DEFINITIONS AUTOMATIC TAGS ::= -BEGIN - Afters ::= CHOICE { cheese IA5String, - dessert IA5String } -END -</pre> - - <p>Tags will not be mentioned any more in this manual.</p> - </section> - - <section> - <marker id="ASN1Types"></marker> - <title>The ASN.1 Types</title> - <p>This section describes the ASN.1 types including their - functionality, purpose and how values are assigned in Erlang. - </p> - <p>ASN.1 has both primitive and constructed types:</p> - <p></p> - <table> - <row> - <cell align="left" valign="middle"><em>Primitive types</em></cell> - <cell align="left" valign="middle"><em>Constructed types</em></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#BOOLEAN">BOOLEAN</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#SEQUENCE">SEQUENCE</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#INTEGER">INTEGER</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#SET">SET</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#REAL">REAL</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#CHOICE">CHOICE</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#NULL">NULL</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#SOF">SET OF and SEQUENCE OF</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#ENUMERATED">ENUMERATED</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#ANY">ANY</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#BIT STRING">BIT STRING</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#ANY">ANY DEFINED BY</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#OCTET STRING">OCTET STRING</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EXTERNAL</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#Character Strings">Character Strings</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EMBEDDED PDV</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#OBJECT IDENTIFIER">OBJECT IDENTIFIER</seealso></cell> - <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">CHARACTER STRING</seealso></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#Object Descriptor">Object Descriptor</seealso></cell> - <cell align="left" valign="middle"></cell> - </row> - <row> - <cell align="left" valign="middle"><seealso marker="#The TIME types">The TIME types</seealso></cell> - <cell align="left" valign="middle"></cell> - </row> - <tcaption>The supported ASN.1 types</tcaption> - </table> - <marker id="TypeNameValue"></marker> - <note> - <p>Values of each ASN.1 type has its own representation in Erlang - described in the following subsections. Users shall provide - these values for encoding according to the representation, as - in the example below.</p> - </note> - <pre> -Operational ::= BOOLEAN --ASN.1 definition </pre> - <p>In Erlang code it may look like:</p> - <pre> -Val = true, -{ok,Bytes} = MyModule:encode('Operational', Val), </pre> - <p>Below follows a description of how - values of each type can be represented in Erlang. - </p> - - <section> - <marker id="BOOLEAN"></marker> - <title>BOOLEAN</title> - <p>Booleans in ASN.1 express values that can be either - TRUE or FALSE. - The meanings assigned to TRUE or FALSE is beyond the scope - of this text. <br></br> - - In ASN.1 it is possible to have:</p> - <pre> -Operational ::= BOOLEAN - </pre> - <p>Assigning a value to the type Operational in Erlang is possible by - using the following Erlang code:</p> - <code type="erl"> -Myvar1 = true, - </code> - <p>Thus, in Erlang the atoms <c>true</c> and <c>false</c> are used - to encode a boolean value.</p> - </section> - - <section> - <marker id="INTEGER"></marker> - <title>INTEGER</title> - <p>ASN.1 itself specifies indefinitely large integers, and the Erlang - systems with versions 4.3 and higher, support very large - integers, in practice indefinitely large integers.</p> - <p>The concept of sub-typing can be applied to integers as well - as to other ASN.1 types. The details of sub-typing are not - explained here, for further info see [<cite id="X.680"></cite>]. A variety - of syntaxes are allowed when defining a type as an integer:</p> - <pre> -T1 ::= INTEGER -T2 ::= INTEGER (-2..7) -T3 ::= INTEGER (0..MAX) -T4 ::= INTEGER (0<..MAX) -T5 ::= INTEGER (MIN<..-99) -T6 ::= INTEGER {red(0),blue(1),white(2)} - </pre> - <p>The Erlang representation of an ASN.1 INTEGER is an integer or - an atom if a so called <c>Named Number List</c> (see T6 above) - is specified.</p> - <p>Below is an example of Erlang code which assigns values for the - above types: </p> - <pre> -T1value = 0, -T2value = 6, -T6value1 = blue, -T6value2 = 0, -T6value3 = white - </pre> - <p>The Erlang variables above are now bound to valid instances of - ASN.1 defined types. This style of value can be passed directly - to the encoder for transformation into a series of bytes.</p> - <p>The decoder will return an atom if the value corresponds to a - symbol in the Named Number List.</p> - </section> - - <section> - <marker id="REAL"></marker> - <title>REAL</title> - <p>The following ASN.1 type is used for real numbers:</p> - <pre> -R1 ::= REAL - </pre> - <p>It can be assigned a value in Erlang as:</p> - <pre> -R1value1 = "2.14", -R1value2 = {256,10,-2}, - </pre> - <p>In the last line note that the tuple {256,10,-2} is the real number - 2.56 in a special notation, which will encode faster than simply - stating the number as <c>"2.56"</c>. The arity three tuple is - <c>{Mantissa,Base,Exponent}</c> i.e. Mantissa * Base^Exponent.</p> - </section> - - <section> - <marker id="NULL"></marker> - <title>NULL</title> - <p>Null is suitable in cases where supply and recognition of a value - is important but the actual value is not.</p> - <pre> -Notype ::= NULL - </pre> - <p>The NULL type can be assigned in Erlang:</p> - <pre> -N1 = 'NULL', - </pre> - <p>The actual value is the quoted atom 'NULL'.</p> - </section> - - <section> - <marker id="ENUMERATED"></marker> - <title>ENUMERATED</title> - <p>The enumerated type can be used, when the value we wish to - describe, may only take one of a set of predefined values.</p> - <pre> -DaysOfTheWeek ::= ENUMERATED { - sunday(1),monday(2),tuesday(3), - wednesday(4),thursday(5),friday(6),saturday(7) } - </pre> - <p>For example to assign a weekday value in Erlang use the same atom - as in the <c>Enumerations</c> of the type definition:</p> - <pre> -Day1 = saturday, - </pre> - <p>The enumerated type is very similar to an integer type, when - defined with a set of predefined values. An enumerated type - differs from an integer in that it may only have specified - values, whereas an integer can also have any other value.</p> - </section> - - <section> - <marker id="BIT STRING"></marker> - <title>BIT STRING</title> - <p>The BIT STRING type can be used to model information which - is made up of arbitrary length series of bits. It is intended - to be used for a selection of flags, not for binary files. <br></br> - - In ASN.1 BIT STRING definitions may look like: - </p> - <pre> -Bits1 ::= BIT STRING -Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)} - </pre> - <p>There are two notations available for representation of - BIT STRING values in Erlang and as input to the encode functions.</p> - <list type="ordered"> - <item>A bitstring. By default, a BIT STRING with no - symbolic names will be decoded to an Erlang bitstring.</item> - <item>A list of atoms corresponding to atoms in the <c>NamedBitList</c> - in the BIT STRING definition. A BIT STRING with symbolic - names will always be decoded to this format.</item> - </list> - <p>Example:</p> - <pre> -Bits1Val1 = <<0:1,1:1,0:1,1:1,1:1>>, -Bits2Val1 = [gnu,punk], -Bits2Val2 = <<2#1110:4>>, -Bits2Val3 = [bar,gnu,gnome], - </pre> - <p><c>Bits2Val2</c> and <c>Bits2Val3</c> above denote the same value.</p> - <p><c>Bits2Val1</c> is assigned symbolic values. The assignment means - that the bits corresponding to <c>gnu</c> and <c>punk</c> i.e. bits - 2 and 14 are set to 1 and the rest set to 0. The symbolic values - appear as a list of values. If a named value appears, which is not - specified in the type definition, a run-time error will occur.</p> - <p>BIT STRINGS may also be sub-typed with, for example, a SIZE - specification:</p> - <pre> -Bits3 ::= BIT STRING (SIZE(0..31)) </pre> - <p>This means that no bit higher than 31 can ever be set.</p> - - <section> - <title>Deprecated representations for BIT STRING</title> - <p>In addition to the representations described above, the - following deprecated representations are available if the - specification has been compiled with the - <c>legacy_erlang_types</c> option:</p> - <list type="ordered"> - <item>A list of binary digits (0 or 1). This format is - accepted as input to the encode functions, and a BIT STRING - will be decoded to this format if the - <em>legacy_bit_string</em> option has been given. - </item> - <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes - how many trailing zero-bits 0 to 7 that are unused in the - least significant byte in <c>Binary</c>. This format is - accepted as input to the encode functions, and a <c>BIT - STRING</c> will be decoded to this format if - <em>compact_bit_string</em> has been given. - </item> - <item>A hexadecimal number (or an integer). This format - should be avoided, since it is easy to misinterpret a BIT - STRING value in this format. - </item> - </list> - </section> - </section> - - <section> - <marker id="OCTET STRING"></marker> - <title>OCTET STRING</title> - <p>The OCTET STRING is the simplest of all ASN.1 types. The - OCTET STRING only moves or transfers e.g. binary files or other - unstructured information complying to two rules. Firstly, the - bytes consist of octets and secondly, encoding is not - required.</p> - <p>It is possible to have the following ASN.1 type definitions:</p> - <pre> -O1 ::= OCTET STRING -O2 ::= OCTET STRING (SIZE(28)) </pre> - <p>With the following example assignments in Erlang:</p> - <pre> -O1Val = <<17,13,19,20,0,0,255,254>>, -O2Val = <<"must be exactly 28 chars....">>,</pre> - <p>By default, an OCTET STRING is always represented as - an Erlang binary. If the specification has been compiled with - the <c>legacy_erlang_types</c> option, the encode functions - will accept both lists and binaries, and the decode functions - will decode an OCTET STRING to a list.</p> - </section> - - <section> - <marker id="Character Strings"></marker> - <title>Character Strings</title> - <p>ASN.1 supports a wide variety of character sets. The main difference - between OCTET STRINGS and the Character strings is that OCTET - STRINGS have no imposed semantics on the bytes delivered.</p> - <p>However, when using for instance the IA5String (which closely - resembles ASCII) the byte 65 (in decimal - notation) <em>means</em> the character 'A'. - </p> - <p>For example, if a defined type is to be a VideotexString and - an octet is received with the unsigned integer value X, then - the octet should be interpreted as specified in the standard - ITU-T T.100,T.101. - </p> - <p>The ASN.1 to Erlang compiler - will not determine the correct interpretation of each BER - (Basic Encoding Rules) string octet value with different - Character strings. Interpretation of octets is the - responsibility of the application. Therefore, from the BER - string point of view, octets appear to be very similar to - character strings and are compiled in the same way. - </p> - <p>It should be noted that when PER (Packed Encoding Rules) is - used, there is a significant difference in the encoding scheme - between OCTET STRINGS and other strings. The constraints - specified for a type are especially important for PER, where - they affect the encoding. - </p> - <p>Here are some examples:</p> - <pre> -Digs ::= NumericString (SIZE(1..3)) -TextFile ::= IA5String (SIZE(0..64000)) </pre> - <p>with corresponding Erlang assignments:</p> - <pre> -DigsVal1 = "456", -DigsVal2 = "123", -TextFileVal1 = "abc...xyz...", -TextFileVal2 = [88,76,55,44,99,121 .......... a lot of characters here ....] </pre> - <p>The Erlang representation for "BMPString" and - "UniversalString" is either a list of ASCII values or a list - of quadruples. The quadruple representation associates to the - Unicode standard representation of characters. The ASCII - characters are all represented by quadruples beginning with - three zeros like {0,0,0,65} for the 'A' character. When - decoding a value for these strings the result is a list of - quadruples, or integers when the value is an ASCII character.</p> - - <p>The following example shows how it works. We have the following - specification in the file <c>PrimStrings.asn1</c>.</p> - <pre> -PrimStrings DEFINITIONS AUTOMATIC TAGS ::= -BEGIN - BMP ::= BMPString -END - </pre> - - <p>Encoding and decoding some strings:</p> - - <pre> -1> <input>asn1ct:compile('PrimStrings', [ber]).</input> -ok -2> <input>{ok,Bytes1} = 'PrimStrings':encode('BMP', [{0,0,53,53},{0,0,45,56}]).</input> -{ok,<<30,4,53,54,45,56>>} -3> <input>'PrimStrings':decode('BMP', Bytes1).</input> -{ok,[{0,0,53,53},{0,0,45,56}]} -4> <input>{ok,Bytes2} = 'PrimStrings':encode('BMP', [{0,0,53,53},{0,0,0,65}]).</input> -{ok,<<30,4,53,53,0,65>>} -5> <input>'PrimStrings':decode('BMP', Bytes2).</input> -{ok,[{0,0,53,53},65]} -6> <input>{ok,Bytes3} = 'PrimStrings':encode('BMP', "BMP string").</input> -{ok,<<30,20,0,66,0,77,0,80,0,32,0,115,0,116,0,114,0,105,0,110,0,103>>} -7> <input>'PrimStrings':decode('BMP', Bytes3).</input> -{ok,"BMP string"} </pre> - - <p>The UTF8String type is represented as a UTF-8 encoded binary in - Erlang. Such binaries can be created directly using the binary syntax - or by converting from a list of Unicode code points using the - <c>unicode:characters_to_binary/1</c> function.</p> - - <p>Here are some examples showing how UTF-8 encoded binaries can - be created and manipulated:</p> - - <pre> -1> <input>Gs = "Мой маленький Гном".</input> -[1052,1086,1081,32,1084,1072,1083,1077,1085,1100,1082,1080, - 1081,32,1043,1085,1086,1084] -2> <input>Gbin = unicode:characters_to_binary(Gs).</input> -<<208,156,208,190,208,185,32,208,188,208,176,208,187,208, - 181,208,189,209,140,208,186,208,184,208,185,32,208,147, - 208,...>> -3> <input>Gbin = <<"Мой маленький Гном"/utf8>>.</input> -<<208,156,208,190,208,185,32,208,188,208,176,208,187,208, - 181,208,189,209,140,208,186,208,184,208,185,32,208,147, - 208,...>> -4> <input>Gs = unicode:characters_to_list(Gbin).</input> -[1052,1086,1081,32,1084,1072,1083,1077,1085,1100,1082,1080, - 1081,32,1043,1085,1086,1084] - </pre> - - <p>See the <seealso marker="stdlib:unicode">unicode</seealso> module - for more details.</p> - - <p>In the following example we will use this ASN.1 specification:</p> - <pre> -UTF DEFINITIONS AUTOMATIC TAGS ::= -BEGIN - UTF ::= UTF8String -END - </pre> - - <p>Encoding and decoding a string with Unicode characters:</p> - - <pre> -5> <input>asn1ct:compile('UTF', [ber]).</input> -ok -6> <input>{ok,Bytes1} = 'UTF':encode('UTF', <<"Гном"/utf8>>).</input> -{ok,<<12,8,208,147,208,189,208,190,208,188>>} -7> <input>{ok,Bin1} = 'UTF':decode('UTF', Bytes1).</input> -{ok,<<208,147,208,189,208,190,208,188>>} -8> <input>io:format("~ts\n", [Bin1]).</input> -Гном -ok -9> <input>unicode:characters_to_list(Bin1).</input> -[1043,1085,1086,1084] - </pre> - </section> - - <section> - <marker id="OBJECT IDENTIFIER"></marker> - <title>OBJECT IDENTIFIER</title> - <p>The OBJECT IDENTIFIER is used whenever a unique identity is required. - An ASN.1 module, a transfer syntax, etc. is identified with an - OBJECT IDENTIFIER. Assume the example below:</p> - <pre> -Oid ::= OBJECT IDENTIFIER - </pre> - <p>Therefore, the example below is a valid Erlang instance of the - type 'Oid'.</p> - <pre> -OidVal1 = {1,2,55}, - </pre> - <p>The OBJECT IDENTIFIER value is simply a tuple with the - consecutive values which must be integers. - </p> - <p>The first value is limited to the values 0, 1 or 2 and the - second value must be in the range 0..39 when the first value - is 0 or 1. - </p> - <p>The OBJECT IDENTIFIER is a very important type and it is - widely used within different standards to uniquely identify - various objects. In [<cite id="DUBUISSON"></cite>], there is an - easy-to-understand description of the usage of - OBJECT IDENTIFIER.</p> - <p></p> - </section> - - <section> - <marker id="Object Descriptor"></marker> - <title>Object Descriptor</title> - <p>Values of this type can be assigned a value as an ordinary string - like this:</p> - - <pre> - "This is the value of an Object descriptor"</pre> - </section> - - <section> - <marker id="The TIME types"></marker> - <title>The TIME Types</title> - <p>Two different time types are defined within ASN.1, Generalized - Time and UTC (Universal Time Coordinated), both are assigned a - value as an ordinary string within double quotes i.e. - "19820102070533.8".</p> - <p>In case of DER encoding the compiler does not check the validity - of the time values. The DER requirements upon those strings is - regarded as a matter for the application to fulfill.</p> - </section> - - <section> - <marker id="SEQUENCE"></marker> - <title>SEQUENCE</title> - <p>The structured types of ASN.1 are constructed from other types - in a manner similar to the concepts of array and struct in C. - <br></br> - A SEQUENCE in ASN.1 is - comparable with a struct in C and a record in Erlang. - A SEQUENCE may be defined as:</p> - <pre> -Pdu ::= SEQUENCE { - a INTEGER, - b REAL, - c OBJECT IDENTIFIER, - d NULL } </pre> - <p>This is a 4-component structure called 'Pdu'. The major format - for representation of SEQUENCE in Erlang is the record format. - For each SEQUENCE and <c>SET</c> in an ASN.1 module an Erlang - record declaration is generated. For <c>Pdu</c> above, a record - like this is defined:</p> - <pre> --record('Pdu',{a, b, c, d}). </pre> - <p>The record declarations for a module <c>M</c> are placed in a - separate <c>M.hrl</c> file.</p> - <p>Values can be assigned in Erlang as shown below:</p> - <pre> -MyPdu = #'Pdu'{a=22,b=77.99,c={0,1,2,3,4},d='NULL'}. </pre> - <p>The decode functions will return a record as result when decoding - a <c>SEQUENCE</c> or a <c>SET</c>.</p> - - <p>A <c>SEQUENCE</c> and a <c>SET</c> may contain a component - with a <c>DEFAULT</c> key word followed by the actual value that - is the default value. The <c>DEFAULT</c> keyword means that the - application doing the encoding can omit encoding of the value, - thus resulting in fewer bytes to send to the receiving - application.</p> - - <p>An application can use the atom <c>asn1_DEFAULT</c> to indicate - that the encoding should be omitted for that position in - the SEQUENCE.</p> - - <p>Depending on the encoding rules, the encoder may also compare - the given value to the default value and automatically omit the - encoding if they are equal. How much effort the encoder makes to - to compare the values depends on the encoding rules. The DER - encoding rules forbids encoding a value equal to the default value, - so it has a more thorough and time-consuming comparison than the - encoders for the other encoding rules.</p> - - <p>In the following example we will use this ASN.1 specification:</p> - <pre> -File DEFINITIONS AUTOMATIC TAGS ::= -BEGIN -Seq1 ::= SEQUENCE { - a INTEGER DEFAULT 1, - b Seq2 DEFAULT {aa TRUE, bb 15} -} - -Seq2 ::= SEQUENCE { - aa BOOLEAN, - bb INTEGER -} - -Seq3 ::= SEQUENCE { - bs BIT STRING {a(0), b(1), c(2)} DEFAULT {a, c} -} -END </pre> - <p>Here is an example where the BER encoder is able to omit encoding - of the default values:</p> - <pre> -1> <input>asn1ct:compile('File', [ber]).</input> -ok -2> <input>'File':encode('Seq1', {'Seq1',asn1_DEFAULT,asn1_DEFAULT}).</input> -{ok,<<48,0>>} -3> <input>'File':encode('Seq1', {'Seq1',1,{'Seq2',true,15}}).</input> -{ok,<<48,0>>} </pre> - - <p>And here is an example with a named BIT STRING where the BER - encoder will not omit the encoding:</p> - <pre> -4> <input>'File':encode('Seq3', {'Seq3',asn1_DEFAULT).</input> -{ok,<<48,0>>} -5> <input>'File':encode('Seq3', {'Seq3',<<16#101:3>>).</input> -{ok,<<48,4,128,2,5,160>>} </pre> - - <p>The DER encoder will omit the encoding for the same BIT STRING:</p> - <pre> -6> <input>asn1ct:compile('File', [ber,der]).</input> -ok -7> <input>'File':encode('Seq3', {'Seq3',asn1_DEFAULT).</input> -{ok,<<48,0>>} -8> <input>'File':encode('Seq3', {'Seq3',<<16#101:3>>).</input> -{ok,<<48,0>>} </pre> - </section> - - <section> - <marker id="SET"></marker> - <title>SET</title> - <p>In Erlang, the SET type is used exactly as SEQUENCE. Note - that if the BER or DER encoding rules are used, decoding a - SET is slower than decoding a SEQUENCE because the components - must be sorted.</p> - </section> - - <section> - <title>Notes about extensibility for SEQUENCE and SET</title> - <p>When a SEQUENCE or SET contains an extension marker and - extension components like this:</p> - <pre> -SExt ::= SEQUENCE { - a INTEGER, - ..., - b BOOLEAN } - </pre> - <p>It means that the type may get more components in newer - versions of the ASN.1 spec. In this case it has got a new - component <c>b</c>. Thus, incoming messages that will be decoded - may have more or fever components than this one. - </p> - <p>The component <c>b</c> will be treated as - an original component when encoding a message. In this case, as - it is not an optional element, it must be encoded. - </p> - <p>During decoding the <c>b</c> field of the record will get the decoded - value of the <c>b</c> - component if present and otherwise the value <c>asn1_NOVALUE</c>.</p> - </section> - - <section> - <marker id="CHOICE"></marker> - <title>CHOICE</title> - <p>The CHOICE type is a space saver and is similar to the concept of a - 'union' in the C language.</p> - <p>Assume:</p> - <pre> -SomeModuleName DEFINITIONS AUTOMATIC TAGS ::= -BEGIN -T ::= CHOICE { - x REAL, - y INTEGER, - z OBJECT IDENTIFIER } -END </pre> - <p>It is then possible to assign values:</p> - <pre> -TVal1 = {y,17}, -TVal2 = {z,{0,1,2}}, - </pre> - <p>A CHOICE value is always represented as the tuple - <c>{ChoiceAlternative, Val}</c> where <c>ChoiceAlternative</c> - is an atom denoting the selected choice alternative. - </p> - - <section> - <title>Extensible CHOICE</title> - <p>When a CHOICE contains an extension marker and the decoder detects - an unknown alternative of the CHOICE the value is represented as:</p> - <pre> -{asn1_ExtAlt, BytesForOpenType} - </pre> - <p>Where <c>BytesForOpenType</c> is a list of bytes constituting the - encoding of the "unknown" CHOICE alternative. </p> - </section> - </section> - - <section> - <marker id="SOF"></marker> - <title>SET OF and SEQUENCE OF</title> - <p>The SET OF and SEQUENCE OF types correspond to the concept of an array - found in several programming languages. The Erlang syntax for - both of these types is straight forward. For example:</p> - <pre> -Arr1 ::= SET SIZE (5) OF INTEGER (4..9) -Arr2 ::= SEQUENCE OF OCTET STRING </pre> - <p>We may have the following in Erlang:</p> - <pre> -Arr1Val = [4,5,6,7,8], -Arr2Val = ["abc",[14,34,54],"Octets"], </pre> - <p>Please note that the definition of the SET OF type implies that - the order of the components is undefined, but in practice there is - no difference between SET OF and SEQUENCE OF. The ASN.1 compiler - for Erlang does not randomize the order of the SET OF components - before encoding.</p> - <p>However, in case of a value of the type <c>SET OF</c>, the DER - encoding format requires the elements to be sent in ascending - order of their encoding, which implies an expensive sorting - procedure in run-time. Therefore it is strongly recommended to - use <c>SEQUENCE OF</c> instead of <c>SET OF</c> if it is possible.</p> - </section> - - <section> - <marker id="ANY"></marker> - <title>ANY and ANY DEFINED BY</title> - <p>The types <c>ANY</c> and <c>ANY DEFINED BY</c> have been removed - from the standard since 1994. It is recommended not to use - these types any more. They may, however, exist in some old ASN.1 - modules. - The idea with this type was to leave a "hole" in a definition where - one could put unspecified data of any kind, even non ASN.1 data.</p> - <p>A value of this type is encoded as an <c>open type</c>.</p> - <p>Instead of <c>ANY</c>/<c>ANY DEFINED BY</c> one should use - <c>information object class</c>, <c>table constraints</c> and - <c>parameterization</c>. In particular the construct - <c>TYPE-IDENTIFIER.@Type</c> accomplish the same as the - deprecated <c>ANY</c>.</p> - <p>See also <seealso marker="#Information Object">Information object</seealso></p> - </section> - - <section> - <marker id="NegotiationTypes"></marker> - <title>EXTERNAL, EMBEDDED PDV and CHARACTER STRING</title> - <p>These types are used in presentation layer negotiation. They are - encoded according to their associated type, see [<cite id="X.680"></cite>].</p> - <p>The <c>EXTERNAL</c> type had a slightly different associated type - before 1994. [<cite id="X.691"></cite>] states that encoding shall follow - the older associate type. Therefore does generated encode/decode - functions convert values of the newer format to the older format - before encoding. This implies that it is allowed to use - <c>EXTERNAL</c> type values of either format for encoding. Decoded - values are always returned on the newer format.</p> - </section> - - <section> - <title>Embedded Named Types</title> - <p>The structured types previously described may very well have other named types - as their components. The general syntax to assign a value to the component C - of a named ASN.1 type T in Erlang is the record syntax - <c>#'T'{'C'=Value}</c>. - Where <c>Value</c> may be a value of yet another type T2.</p> - <p>For example:</p> - <pre> -EmbeddedExample DEFINITIONS AUTOMATIC TAGS ::= -BEGIN -B ::= SEQUENCE { - a Arr1, - b T } - -Arr1 ::= SET SIZE (5) OF INTEGER (4..9) - -T ::= CHOICE { - x REAL, - y INTEGER, - z OBJECT IDENTIFIER } - END </pre> - <p>The SEQUENCE b can be encoded like this in Erlang:</p> - <pre> -1> 'EmbeddedExample':encode('B', {'B',[4,5,6,7,8],{x,"7.77"}}). -{ok,<<5,56,0,8,3,55,55,55,46,69,45,50>>} </pre> - </section> - </section> - - <section> - <title>Naming of Records in .hrl Files</title> - <p>When an ASN.1 specification is compiled all defined types of - type SET or SEQUENCE will result in a corresponding record in the - generated hrl file. This is because the values for SET/SEQUENCE - as mentioned in sections above are represented as records.</p> - <p>Though there are some special cases of this functionality that - are presented below.</p> - - <section> - <title>Embedded Structured Types</title> - <p>It is also possible in ASN.1 to have components that are themselves - structured types. - For example, it is possible to have:</p> - <pre> -Emb ::= SEQUENCE { - a SEQUENCE OF OCTET STRING, - b SET { - a INTEGER, - b INTEGER DEFAULT 66}, - c CHOICE { - a INTEGER, - b FooType } } - -FooType ::= [3] VisibleString </pre> - <p>The following records are generated because of the type <c>Emb</c>:</p> - <pre> --record('Emb,{a, b, c}). --record('Emb_b',{a, b = asn1_DEFAULT}). % the embedded SET type - </pre> - <p>Values of the <c>Emb</c> type can be assigned like this:</p> - <code type="none"> -V = #'Emb'{a=["qqqq",[1,2,255]], - b = #'Emb_b'{a=99}, - c ={b,"Can you see this"}}. - </code> - <p>For an embedded type of type SEQUENCE/SET in a SEQUENCE/SET - the record name is extended with an underscore and the component - name. If the embedded structure is deeper with SEQUENCE, SET or - CHOICE types in the line, each component-/alternative-name will - be added to the record-name.</p> - <p>For example:</p> - <pre> -Seq ::= SEQUENCE{ - a CHOICE{ - b SEQUENCE { - c INTEGER - } - } -} </pre> - <p>will result in the following record:</p> - <pre> --record('Seq_a_b',{c}). </pre> - <p>If the structured type has a component with an embedded - SEQUENCE OF/SET OF which embedded type in turn is a - SEQUENCE/SET it will give a record with the SEQOF/SETOF - addition as in the following example:</p> - <pre> -Seq ::= SEQUENCE { - a SEQUENCE OF SEQUENCE { - b - } - c SET OF SEQUENCE { - d - } -} </pre> - <p>This results in the records:</p> - <pre> --record('Seq_a_SEQOF'{b}). --record('Seq_c_SETOF'{d}). </pre> - <p>A parameterized type should be considered as an embedded - type. Each time a such type is referenced an instance of it is - defined. Thus in the following example a record with name - <c>'Seq_b'</c> is generated in the .hrl file and used to hold - values.</p> - <pre> -Seq ::= SEQUENCE { - b PType{INTEGER} -} - -PType{T} ::= SEQUENCE{ - id T -} </pre> - </section> - - <section> - <title>Recursive Types</title> - <p>Types may refer to themselves. Suppose:</p> - <pre> -Rec ::= CHOICE { - nothing NULL, - something SEQUENCE { - a INTEGER, - b OCTET STRING, - c Rec }} </pre> - <p>This type is recursive; that is, it refers to itself. This is allowed - in ASN.1 and the ASN.1-to-Erlang compiler supports this recursive - type. A value for this type is assigned in Erlang as shown below:</p> - <pre> -V = {something,#'Rec_something'{a = 77, - b = "some octets here", - c = {nothing,'NULL'}}}. </pre> - </section> - </section> - - <section> - <title>ASN.1 Values</title> - <p>Values can be assigned to ASN.1 type within the ASN.1 code - itself, as opposed to the actions taken in the previous chapter where - a value was assigned to an ASN.1 type in Erlang. The full value - syntax of ASN.1 is supported and [X.680] describes in detail how - to assign values in ASN.1. Below is a short example:</p> - <pre> -TT ::= SEQUENCE { - a INTEGER, - b SET OF OCTET STRING } - -tt TT ::= {a 77,b {"kalle","kula"}} </pre> - <p>The value defined here could be used in several ways. - Firstly, it could be used as the value in some DEFAULT component:</p> - <pre> -SS ::= SET { - s OBJECT IDENTIFIER, - val TT DEFAULT tt } </pre> - <p>It could also be used from inside an Erlang program. If the above ASN.1 - code was defined in ASN.1 module <c>Values</c>, then the ASN.1 value - <c>tt</c> can be reached from Erlang as - a function call to <c>'Values':tt()</c> as in the example below.</p> - <pre> -1> <input>Val = 'Values':tt().</input> -{'TT',77,["kalle","kula"]} -2> <input>{ok,Bytes} = 'Values':encode('TT',Val).</input> -{ok,<<48,18,128,1,77,161,13,4,5,107,97,108,108,101,4,4, - 107,117,108,97>>} -4> <input>'Values':decode('TT',Bytes).</input> -{ok,{'TT',77,["kalle","kula"]}} -5> - </pre> - <p>The above example shows that a function is generated by the compiler - that returns a valid Erlang representation of the value, even though - the value is of a complex type.</p> - <p>Furthermore, there is a macro generated for each value in the .hrl - file. So, the defined value <c>tt</c> can also be extracted by - <c>?tt</c> in application code.</p> - </section> - - <section> - <title>Macros</title> - <p>MACRO is not supported as the the type is no longer part of the - ASN.1 standard.</p> - </section> - - <section> - <marker id="Information Object"></marker> - <title>ASN.1 Information Objects (X.681)</title> - <p>Information Object Classes, Information Objects and Information - Object Sets (in the following called classes, objects and - object sets respectively) are defined in the standard - definition [<cite id="X.681"></cite>]. In the following only a brief - explanation is given. </p> - <p>These constructs makes it possible to define open types, - i.e. values of that type can be of any ASN.1 type. It is also - possible to define relationships between different types and - values, since classes can hold types, values, objects, object - sets and other classes in its fields. - An Information Object Class may be defined in ASN.1 as:</p> - <pre> -GENERAL-PROCEDURE ::= CLASS { - &Message, - &Reply OPTIONAL, - &Error OPTIONAL, - &id PrintableString UNIQUE -} -WITH SYNTAX { - NEW MESSAGE &Message - [REPLY &Reply] - [ERROR &Error] - ADDRESS &id -} </pre> - <p>An object is an instance of a class and an object set is a set - containing objects of one specified class. A definition may look like - below.</p> - <p>The object <c>object1</c> is an instance of the CLASS - GENERAL-PROCEDURE and has one type field and one fixed type value - field. The object <c>object2</c> also has an OPTIONAL field ERROR, - which is a type field.</p> - <pre> -object1 GENERAL-PROCEDURE ::= { - NEW MESSAGE PrintableString - ADDRESS "home" -} - -object2 GENERAL-PROCEDURE ::= { - NEW MESSAGE INTEGER - ERROR INTEGER - ADDRESS "remote" -} </pre> - <p>The field ADDRESS is a UNIQUE field. Objects in an object set must - have unique values in their UNIQUE field, as in GENERAL-PROCEDURES: </p> - <pre> -GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { - object1 | object2} </pre> - <p>One can not encode a class, object or object set, only referring to - it when defining other ASN.1 entities. Typically one refers to a - class and to object sets by table constraints and component - relation constraints [<cite id="X.682"></cite>] in ASN.1 types, as in: </p> - <pre> -StartMessage ::= SEQUENCE { - msgId GENERAL-PROCEDURE.&id ({GENERAL-PROCEDURES}), - content GENERAL-PROCEDURE.&Message ({GENERAL-PROCEDURES}{@msgId}), - } </pre> - <p>In the type <c>StartMessage</c> the constraint following the - <c>content</c> field tells that in a value of type - <c>StartMessage</c> the value in the <c>content</c> field must - come from the same object that is chosen by the <c>msgId</c> - field.</p> - <p>So, the value <c>#'StartMessage'{msgId="home",content="Any Printable String"}</c> is legal to encode as a StartMessage - value, while the value <c>#'StartMessage'{msgId="remote", content="Some String"}</c> is illegal since the constraint - in StartMessage tells that when you have chosen a value from a - specific object in the object set GENERAL-PROCEDURES in the - msgId field you have to choose a value from that same object in - the content field too. In this second case it should have been - any INTEGER value.</p> - <p><c>StartMessage</c> can in the <c>content</c> field be - encoded with a value of any type that an object in the - <c>GENERAL-PROCEDURES</c> object set has in its <c>NEW MESSAGE</c> field. This field refers to a type field - <c>&Message</c> in the class. The <c>msgId</c> field is always - encoded as a PrintableString, since the field refers to a fixed type - in the class.</p> - <p>In practice, object sets are usually declared to be extensible so - so that more objects can be added to the set later. Extensibility is - indicated like this:</p> - <pre> -GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { - object1 | object2, ...} </pre> - <p>When decoding a type that uses an extensible set constraint, - there is always the possibility that the value in the UNIQUE - field is unknown (i.e. the type has been encoded with a later - version of the ASN.1 specification). When that happens, the - unencoded data will be returned wrapped in a tuple like this:</p> - - <pre> -{asn1_OPENTYPE,Binary}</pre> - <p>where <c>Binary</c> is an Erlang binary that contains the encoded - data. (If the option <c>legacy_erlang_types</c> has been given, - just the binary will be returned.)</p> - </section> - - <section> - <title>Parameterization (X.683)</title> - <p>Parameterization, which is defined in the standard [<cite id="X.683"></cite>], can be used when defining types, values, value - sets, information object classes, information objects or - information object sets. - A part of a definition can be supplied as a parameter. For - instance, if a Type is used in a definition with certain - purpose, one want the type-name to express the intention. This - can be done with parameterization.</p> - <p>When many types (or another ASN.1 entity) only differs in some - minor cases, but the structure of the types are similar, only - one general type can be defined and the differences may be supplied - through parameters. </p> - <p>One example of use of parameterization is:</p> - <pre> -General{Type} ::= SEQUENCE -{ - number INTEGER, - string Type -} - -T1 ::= General{PrintableString} - -T2 ::= General{BIT STRING} - </pre> - <p>An example of a value that can be encoded as type T1 is {12,"hello"}.</p> - <p>Note that the compiler does not generate encode/decode functions for - parameterized types, but only for the instances of the parameterized - types. Therefore, if a file contains the types General{}, T1 and T2 above, - encode/decode functions will only be generated for T1 and T2. - </p> - </section> -</chapter> - diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 32ff2d52cf..4e0bf055fc 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -35,43 +35,45 @@ <modulesummary>ASN.1 compiler and compile-time support functions</modulesummary> <description> <p>The ASN.1 compiler takes an ASN.1 module as input and generates a - corresponding Erlang module which can encode and decode the data-types - specified. Alternatively the compiler takes a specification module - (se below) specifying all input modules and generates one module with - encode/decode functions. There are also some generic functions which - can be used in during development of applications which handles ASN.1 - data (encoded as BER or PER).</p> + corresponding Erlang module, which can encode and decode the specified + data types. Alternatively, the compiler takes a specification module + specifying all input modules, and generates a module with + encode/decode functions. In addition, some generic functions + can be used during development of applications that handles ASN.1 + data (encoded as <c>BER</c> or <c>PER</c>).</p> + <note> - <p>By default in OTP 17, the representation of the BIT STRING - and OCTET STRING types as Erlang terms have changed. BIT - STRING values are now Erlang bitstrings and OCTET STRING values - are binaries. Also, an undecoded open type will now be wrapped in - a <c>asn1_OPENTYPE</c> tuple. For details see <seealso - marker="asn1_ug#BIT STRING">BIT STRING</seealso>, <seealso - marker="asn1_ug#OCTET STRING">OCTET STRING</seealso>, and - <seealso marker="asn1_ug#Information%20Object">ASN.1 Information Objects</seealso> in User's Guide.</p> - <p>To revert to the old representation of the types, use the - <c>legacy_erlang_types</c> option.</p> + <p>By default in OTP 17, the representation of the <c>BIT STRING</c> + and <c>OCTET STRING</c> types as Erlang terms were changed. <c>BIT + STRING</c> values are now Erlang bit strings and <c>OCTET STRING</c> + values are binaries. Also, an undecoded open type is now wrapped in + an <c>asn1_OPENTYPE</c> tuple. For details, see <seealso + marker="asn1_getting_started#BIT STRING">BIT STRING</seealso>, <seealso + marker="asn1_getting_started#OCTET STRING">OCTET STRING</seealso>, and + <seealso marker="asn1_getting_started#Information Object">ASN.1 Information Objects</seealso> in the User's Guide.</p> + <p>To revert to the old representation of the types, use option + <c>legacy_erlang_types</c>.</p> </note> + <note> - <p>In R16, the options have been simplified. The back-end is chosen + <p>In OTP R16, the options were simplified. The back end is chosen using one of the options <c>ber</c>, <c>per</c>, or <c>uper</c>. - The options <c>optimize</c>, <c>nif</c>, and <c>driver</c> options - are no longer necessary (and the ASN.1 compiler will print a - warning if they are used). The options <c>ber_bin</c>, <c>per_bin</c>, - and <c>uper_bin</c> options will still work, but will print a warning. + Options <c>optimize</c>, <c>nif</c>, and <c>driver</c> options + are no longer necessary (and the ASN.1 compiler generates a + warning if they are used). Options <c>ber_bin</c>, <c>per_bin</c>, + and <c>uper_bin</c> options still work, but generates a warning. </p> - <p>Another change in R16 is that the generated <c>encode/2</c> - function always returns a binary. - The <c>encode/2</c> function for the BER back-end used to return - an iolist.</p> + <p>Another change in OTP R16 is that the generated function + <c>encode/2</c> always returns a binary. Function <c>encode/2</c> + for the <c>BER</c> back end used to return an iolist.</p> </note> </description> + <funcs> <func> <name>compile(Asn1module) -> ok | {error, Reason}</name> <name>compile(Asn1module, Options) -> ok | {error, Reason}</name> - <fsummary>Compile an ASN.1 module and generate encode/decode functions according to the encoding rules BER or PER.</fsummary> + <fsummary>Compiles an ASN.1 module and generates encode/decode functions according to encoding rules BER or PER.</fsummary> <type> <v>Asn1module = atom() | string()</v> <v>Options = [Option| OldOption]</v> @@ -85,79 +87,82 @@ <v>Prefix = string()</v> </type> <desc> - <p>Compiles the ASN.1 module <c>Asn1module</c> and generates an - Erlang module <c>Asn1module.erl</c> with encode and decode + <p>Compiles the <c>ASN.1</c> module <c>Asn1module</c> and generates + an Erlang module <c>Asn1module.erl</c> with encode and decode functions for the types defined in <c>Asn1module</c>. For each - ASN.1 value defined in the module an Erlang function which + ASN.1 value defined in the module, an Erlang function that returns the value in Erlang representation is generated.</p> - <p>If <c>Asn1module</c> is a filename without extension first - <c>".asn1"</c> is assumed, then <c>".asn"</c> and finally + <p>If <c>Asn1module</c> is a filename without extension, first + <c>".asn1"</c> is assumed, then <c>".asn"</c>, and finally <c>".py"</c> (to be compatible with the old ASN.1 compiler). - Of course <c>Asn1module</c> can be a full pathname (relative or + <c>Asn1module</c> can be a full pathname (relative or absolute) including filename with (or without) extension. <marker id="asn1set"></marker> </p> - <p>If one wishes to compile a set of Asn1 modules into one - Erlang file with encode/decode functions one has to list all + <p>If it is needed to compile a set of <c>ASN.1</c> modules into an + Erlang file with encode/decode functions, ensure to list all involved files in a configuration file. This configuration - file must have a double extension ".set.asn", (".asn" can - alternatively be ".asn1" or ".py"). The input files' names - must be listed, within quotation marks (""), one at each row + file must have a double extension <c>".set.asn"</c> + (<c>".asn"</c> can alternatively be <c>".asn1"</c> or <c>".py"</c>). + List the input file names + within quotation marks (""), one at each row in the file. If the input files are <c>File1.asn</c>, - <c>File2.asn</c> and <c>File3.asn</c> the configuration file - shall look like:</p> + <c>File2.asn</c>, and <c>File3.asn</c>, the configuration file + must look as follows:</p> <pre> File1.asn File2.asn -File3.asn </pre> - <p>The output files will in this case get their names from the - configuration file. If the configuration file has the name - <c>SetOfFiles.set.asn</c> the name of the output files will be - <c>SetOfFiles.hrl, SetOfFiles.erl and SetOfFiles.asn1db</c>.</p> - <p>Sometimes in a system of ASN.1 modules there are different - default tag modes, e.g. AUTOMATIC, IMPLICIT or EXPLICIT. The - multi file compilation resolves the default tagging as if +File3.asn</pre> + <p>The output files in this case get their names from the + configuration file. If the configuration file is named + <c>SetOfFiles.set.asn</c>, the names of the output files are + <c>SetOfFiles.hrl, SetOfFiles.erl, and SetOfFiles.asn1db</c>.</p> + <p>Sometimes in a system of <c>ASN.1</c> modules, different + default tag modes, for example, <c>AUTOMATIC</c>, <c>IMPLICIT</c>, + or <c>EXPLICIT</c>. The + multi-file compilation resolves the default tagging as if the modules were compiled separately.</p> - <p>Another unwanted effect that may occur in multi file compilation - is name collisions. The compiler solves this problem in two - ways: If the definitions are identical then the output module - keeps only one definition with the original name. But if - definitions only have same name and differs in the definition, - then they will be renamed. The new names will be the definition - name and the original module name concatenated.</p> - <p>If any name collision have occurred the compiler reports a - "NOTICE: ..." message that tells if a definition was renamed, + <p>Name collisions is another unwanted effect that can occur in + multi file-compilation. The compiler solves this problem in one + of two ways:</p> + <list type="bulleted"> + <item>If the definitions are identical, the output module + keeps only one definition with the original name.</item> + <item>If the definitions have the same name and differs in the + definition, they are renamed. The new names are the definition + name and the original module name concatenated.</item> + </list> + <p>If a name collision occurs, the compiler reports a + <c>"NOTICE: ..."</c> message that tells if a definition was renamed, and the new name that must be used to encode/decode data.</p> - - <p> - <c>Options</c> is a list with options specific for the asn1 + <p><c>Options</c> is a list with options specific for the <c>ASN.1</c> compiler and options that are applied to the Erlang compiler. - The latter are those that not is recognized as asn1 specific. - Available options are: + The latter are not recognized as <c>ASN.1</c> specific. The + available options are as follows: </p> <taglist> <tag><c>ber | per | uper</c></tag> <item> <p> The encoding rule to be used. The supported encoding rules - are BER (Basic Encoding Rules), - PER aligned (Packed Encoding Rules) and PER unaligned. - If the encoding rule option is omitted <c>ber</c> + are Basic Encoding Rules (BER), + Packed Encoding Rules (PER) aligned, and PER unaligned. + If the encoding rule option is omitted, <c>ber</c> is the default. </p> <p> The generated Erlang module always gets the same name - as the ASN.1 module and as a consequence of this only one - encoding rule per ASN.1 module can be used at runtime. + as the <c>ASN.1</c> module. Therefore, only one + encoding rule per <c>ASN.1</c> module can be used at runtime. </p> </item> <tag><c>der</c></tag> <item> <p> - By this option the Distinguished Encoding Rules (DER) is chosen. + With this option the Distinguished Encoding Rules (DER) is chosen. DER is regarded as a specialized variant of the BER encoding - rule, therefore the <c>der</c> option only makes sense together - with the <c>ber</c> option. + rule. Therefore, this option only makes sense together + with option <c>ber</c>. This option sometimes adds sorting and value checks when encoding, which implies a slower encoding. The decoding routines are the same @@ -167,118 +172,123 @@ File3.asn </pre> <tag><c>compact_bit_string</c></tag> <item> <p> - The BIT STRING type will be decoded to the "compact notation". + The <c>BIT STRING</c> type is decoded to "compact notation". <em>This option is not recommended for new code.</em> </p> - <p>For details see - <seealso marker="asn1_ug#BIT STRING"> - BIT STRING type section in the Users Guide - </seealso>. + <p>For details, see Section + <seealso marker="asn1_getting_started#BIT STRING"> + BIT STRING</seealso> in the User's Guide. </p> - <p>This option implies the <c>legacy_erlang_types</c> option.</p> + <p>This option implies option <c>legacy_erlang_types</c>.</p> </item> <tag><c>legacy_bit_string</c></tag> <item> <p> - The BIT STRING type will be decoded to the legacy - format, i.e. a list of zeroes and ones. + The <c>BIT STRING</c> type is decoded to the legacy + format, that is, a list of zeroes and ones. <em>This option is not recommended for new code.</em> </p> - <p>For details see - <seealso marker="asn1_ug#BIT STRING"> - BIT STRING type section in the Users Guide - </seealso>. - <p>This option implies the <c>legacy_erlang_types</c> option.</p> - </p> + <p>For details, see Section + <seealso marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> + in the User's Guide</p> + <p>This option implies option <c>legacy_erlang_types</c>.</p> </item> <tag><c>legacy_erlang_types</c></tag> <item> - <p>Use the same Erlang types to represent BIT STRING and - OCTET STRING as in R16. For details see <seealso - marker="asn1_ug#BIT STRING">BIT STRING</seealso> and - <seealso marker="asn1_ug#OCTET STRING">OCTET - STRING</seealso> in User's Guide.</p> - <p><em>This option is not recommended for - new code.</em></p> + <p>Use the same Erlang types to represent <c>BIT STRING</c> and + <c>OCTET STRING</c> as in OTP R16.</p> + <p>For details, see Section <seealso + marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> and Section + <seealso marker="asn1_getting_started#OCTET STRING">OCTET + STRING</seealso> in the User's Guide.</p> + <p><em>This option is not recommended for new code.</em></p> </item> <tag><c>{n2n, EnumTypeName}</c></tag> <item> <p> - Tells the compiler to generate functions for conversion between - names (as atoms) and numbers and vice versa for the EnumTypeName specified. There can be multiple occurrences of this option in order to specify several type names. The type names must be declared as ENUMERATIONS in the ASN.1 spec. - If the EnumTypeName does not exist in the ASN.1 spec the - compilation will stop with an error code. - The generated conversion functions are named + Tells the compiler to generate functions for conversion + between names (as atoms) and numbers and conversely for + the specified <c>EnumTypeName</c>. There can be multiple + occurrences of this option to specify several type names. + The type names must be declared as <c>ENUMERATIONS</c> in + the ASN.1 specification.</p> + <p> + If <c>EnumTypeName</c> does not exist in the ASN.1 specification, + the compilation stops with an error code.</p> + <p> + The generated conversion functions are named <c>name2num_EnumTypeName/1</c> and <c>num2name_EnumTypeName/1</c>. </p> </item> <tag><c>noobj</c></tag> <item> - <p>Do not compile (i.e do not produce object code) the generated - <c>.erl</c> file. If this option is omitted the generated Erlang module - will be compiled.</p> + <p>Do not compile (that is, do not produce object code) the + generated <c>.erl</c> file. If this option is omitted, the + generated Erlang module is compiled.</p> </item> <tag><c>{i, IncludeDir}</c></tag> <item> <p>Adds <c>IncludeDir</c> to the search-path for - <c>.asn1db</c> and asn1 source files. The compiler tries - to open a <c>.asn1db</c> file when a module imports - definitions from another ASN.1 module. If no - <c>.asn1db</c> file is found the asn1 source file is - parsed. Several <c>{i, IncludeDir}</c> can be given. + <c>.asn1db</c> and <c>ASN.1</c> source files. The compiler + tries to open an <c>.asn1db</c> file when a module imports + definitions from another <c>ASN.1</c> module. If no + <c>.asn1db</c> file is found, the <c>ASN.1</c> source file is + parsed. Several <c>{i, IncludeDir}</c> can be given. </p> </item> <tag><c>{outdir, Dir}</c></tag> <item> - <p>Specifies the directory <c>Dir</c> where all generated files - shall be placed. If omitted the files are placed in the - current directory.</p> + <p>Specifies directory <c>Dir</c> where all generated files + are to be placed. If this option is omitted, the files are + placed in the current directory.</p> </item> <tag><c>asn1config</c></tag> <item> - <p>When one of the specialized decodes, exclusive or - selective decode, is wanted one has to give instructions in - a configuration file. The option <c>asn1config</c> enables - specialized decodes and takes the configuration file, which - has the same name as the ASN.1 spec but with extension - <c>.asn1config</c>, in concern. + <p>When using one of the specialized decodes, exclusive or + selective decode, instructions must be given in + a configuration file. Option <c>asn1config</c> enables + specialized decodes and takes the configuration file in + concern. The configuration file has + the same name as the ASN.1 specification, but with extension + <c>.asn1config</c>. </p> - <p>The instructions for exclusive decode must follow the - <seealso marker="asn1_spec#Exclusive Instruction">instruction and grammar in the User's Guide</seealso>. + <p>For instructions for exclusive decode, see Section + <seealso marker="asn1_spec#Exclusive Instruction">Exclusive + Decode</seealso> in the User's Guide. </p> - <p>You can also find the instructions for selective decode - in the - <seealso marker="asn1_spec#Selective Instruction">User's Guide</seealso>. + <p>For instructions for selective decode, see Section + <seealso marker="asn1_spec#Selective Instruction">Selective + Decode</seealso> in the User's Guide. </p> </item> <tag><c>undec_rest</c></tag> <item> - <p>A buffer that holds a message, being decoded may - also have some following bytes. Now it is possible to get - those following bytes returned together with the decoded - value. If an asn1 spec is compiled with this option a tuple - <c>{ok, Value, Rest}</c> is returned. <c>Rest</c> may be a + <p>A buffer that holds a message, being decoded it can also + have some following bytes. Those following bytes can now + be returned together with the decoded value. If an + ASN.1 specification is compiled with this option, a tuple + <c>{ok, Value, Rest}</c> is returned. <c>Rest</c> can be a list or a binary. Earlier versions of the compiler ignored those following bytes.</p> </item> <tag><c>no_ok_wrapper</c></tag> <item> - <p>If this option is given, the generated <c>encode/2</c> - and <c>decode/2</c> functions will not wrap a successful + <p>With this option, the generated <c>encode/2</c> + and <c>decode/2</c> functions do not wrap a successful return value in an <c>{ok,...}</c> tuple. If any error - occurs, there will be an exception.</p> + occurs, an exception will be raised.</p> </item> <tag><c>{macro_name_prefix, Prefix}</c></tag> <item> <p>All macro names generated by the compiler are prefixed with - <c>Prefix</c>. This is useful when multiple protocols that contains + <c>Prefix</c>. This is useful when multiple protocols that contain macros with identical names are included in a single module.</p> </item> <tag><c>{record_name_prefix, Prefix}</c></tag> <item> <p>All record names generated by the compiler are prefixed with - <c>Prefix</c>. This is useful when multiple protocols that contains + <c>Prefix</c>. This is useful when multiple protocols that contain records with identical names are included in a single module.</p> </item> <tag><c>verbose</c></tag> @@ -291,27 +301,27 @@ File3.asn </pre> <p>Causes warnings to be treated as errors.</p> </item> </taglist> - <p>Any additional option that is applied will be passed to - the final step when the generated .erl file is compiled. + <p>Any more option that is applied is passed to + the final step when the generated <c>.erl</c> file is compiled. </p> <p>The compiler generates the following files:</p> <list type="bulleted"> - <item> - <p><c>Asn1module.hrl</c> (if any SET or SEQUENCE is defined)</p> + <item><c>Asn1module.hrl</c> (if any <c>SET</c> or <c>SEQUENCE</c> + is defined) </item> - <item> - <p><c>Asn1module.erl</c> the Erlang module with encode, decode and value functions.</p> + <item><c>Asn1module.erl</c> - Erlang module with encode, decode, + and value functions </item> - <item> - <p><c>Asn1module.asn1db</c> intermediate format used by the compiler when modules IMPORTS - definitions from each other.</p> + <item><c>Asn1module.asn1db</c> - Intermediate format used by the + compiler when modules <c>IMPORT</c> definitions from each other. </item> </list> </desc> </func> + <func> <name>encode(Module, Type, Value)-> {ok, Bytes} | {error, Reason}</name> - <fsummary>Encode an ASN.1 value.</fsummary> + <fsummary>Encodes an ASN.1 value.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = term()</v> @@ -319,11 +329,11 @@ File3.asn </pre> <v>Reason = term()</v> </type> <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 module - <c>Module</c>. To get as fast execution as possible the - encode function only performs rudimentary tests that the input - <c>Value</c> - is a correct instance of <c>Type</c>. The length of strings is for example + <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> module + <c>Module</c>. To get as fast execution as possible, the + encode function performs only the rudimentary tests that input + <c>Value</c> is a correct instance of <c>Type</c>. So, for example, + the length of strings is not always checked. Returns <c>{ok, Bytes}</c> if successful or <c>{error, Reason}</c> if an error occurred. </p> @@ -331,6 +341,7 @@ File3.asn </pre> Use <c>Module:encode(Type, Value)</c> instead.</p> </desc> </func> + <func> <name>decode(Module, Type, Bytes) -> {ok, Value} | {error, Reason}</name> <fsummary>Decode from Bytes into an ASN.1 value.</fsummary> @@ -346,26 +357,28 @@ File3.asn </pre> Use <c>Module:decode(Type, Bytes)</c> instead.</p> </desc> </func> + <func> <name>value(Module, Type) -> {ok, Value} | {error, Reason}</name> - <fsummary>Create an ASN.1 value for test purposes.</fsummary> + <fsummary>Creates an ASN.1 value for test purposes.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = term()</v> <v>Reason = term()</v> </type> <desc> - <p>Returns an Erlang term which is an example of a valid Erlang - representation of a value of the ASN.1 type <c>Type</c>. The value + <p>Returns an Erlang term that is an example of a valid Erlang + representation of a value of the <c>ASN.1</c> type <c>Type</c>. The value is a random value and subsequent calls to this function will for most types return different values.</p> </desc> </func> + <func> <name>test(Module) -> ok | {error, Reason}</name> <name>test(Module, Type | Options) -> ok | {error, Reason}</name> <name>test(Module, Type, Value | Options) -> ok | {error, Reason}</name> - <fsummary>Perform a test of encode and decode for types in an ASN.1 module.</fsummary> + <fsummary>Performs a test of encode and decode for types in an ASN.1 module.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = term()</v> @@ -376,9 +389,8 @@ File3.asn </pre> <p>Performs a test of encode and decode of types in <c>Module</c>. The generated functions are called by this function. This function is useful during test to secure that the generated - encode and decode functions and the general runtime support work - as expected.</p> - + encode and decode functions as well as the general runtime support + work as expected.</p> <list type="bulleted"> <item> <p><c>test/1</c> iterates over all types in <c>Module</c>.</p> @@ -390,14 +402,12 @@ File3.asn </pre> <p><c>test/3</c> tests type <c>Type</c> with <c>Value</c>.</p> </item> </list> - - <p>Schematically the following happens for each type in the module:</p> + <p>Schematically, the following occurs for each type in the module:</p> <code type="none"> {ok, Value} = asn1ct:value(Module, Type), {ok, Bytes} = asn1ct:encode(Module, Type, Value), {ok, Value} = asn1ct:decode(Module, Type, Bytes).</code> - - <p>The <c>test</c> functions utilizes the <c>*.asn1db</c> files + <p>The <c>test</c> functions use the <c>*.asn1db</c> files for all included modules. If they are located in a different directory than the current working directory, use the include option to add paths. This is only needed when automatically diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml index 3cf56b01ca..f5c334c2ac 100644 --- a/lib/asn1/doc/src/asn1rt.xml +++ b/lib/asn1/doc/src/asn1rt.xml @@ -46,7 +46,7 @@ <func> <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> - <fsummary>Decode from bytes into an ASN.1 value.</fsummary> + <fsummary>Decodes from Bytes into an ASN.1 value.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = Reason = term()</v> @@ -61,7 +61,7 @@ <func> <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> - <fsummary>Encode an ASN.1 value.</fsummary> + <fsummary>Encodes an ASN.1 value.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = term()</v> @@ -69,12 +69,12 @@ <v>Reason = term()</v> </type> <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 + <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> module <c>Module</c>. Returns a binary if successful. To get - as fast execution as possible the encode function only - performs rudimentary tests that the input <c>Value</c> is a - correct instance of <c>Type</c>. The length of strings is, for - example, not always checked. </p> + as fast execution as possible, the encode function performs + only the rudimentary test that input <c>Value</c> is a correct + instance of <c>Type</c>. For example, the length of strings is + not always checked.</p> <p>Use <c>Module:encode(Type, Value)</c> instead of this function.</p> </desc> </func> @@ -88,23 +88,23 @@ <v>Reason = term()</v> </type> <desc> - <p><c>info/1</c> returns the version of the asn1 compiler that was + <p>Returns the version of the <c>ASN.1</c> compiler that was used to compile the module. It also returns the compiler options - that was used.</p> + that were used.</p> <p>Use <c>Module:info()</c> instead of this function.</p> </desc> </func> <func> <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> - <fsummary>Transforms an utf8 encoded binary to a unicode list.</fsummary> + <fsummary>Transforms an UTF8 encoded binary to a unicode list.</fsummary> <type> <v>UTF8Binary = binary()</v> <v>UnicodeList = [integer()]</v> <v>Reason = term()</v> </type> <desc> - <p><c>utf8_binary_to_list/1</c> Transforms a UTF8 encoded binary + <p>Transforms a UTF8 encoded binary to a list of integers, where each integer represents one character as its unicode value. The function fails if the binary is not a properly encoded UTF8 string.</p> @@ -114,14 +114,14 @@ <func> <name>utf8_list_to_binary(UnicodeList) -> {ok,UTF8Binary} | {error,Reason}</name> - <fsummary>Transforms an unicode list ot an utf8 binary.</fsummary> + <fsummary>Transforms an unicode list to a UTF8 binary.</fsummary> <type> <v>UnicodeList = [integer()]</v> <v>UTF8Binary = binary()</v> <v>Reason = term()</v> </type> <desc> - <p><c>utf8_list_to_binary/1</c> Transforms a list of integers, + <p>Transforms a list of integers, where each integer represents one character as its unicode value, to a UTF8 encoded binary.</p> <p>Use <seealso marker="stdlib:unicode#characters_to_binary-1">unicode:characters_to_binary/1</seealso> instead of this function.</p> diff --git a/lib/asn1/doc/src/part.xml b/lib/asn1/doc/src/part.xml index 735ec2e616..104aeb1f34 100644 --- a/lib/asn1/doc/src/part.xml +++ b/lib/asn1/doc/src/part.xml @@ -29,11 +29,14 @@ <file>part.sgml</file> </header> <description> - <p>The <em>Asn1</em> application - contains modules with compile-time and run-time support for ASN.1. + <p>The <c>ASN.1</c> application + contains modules with compile-time and runtime support for + Abstract Syntax Notation One (ASN.1). </p> </description> - <xi:include href="asn1_ug.xml"/> + <xi:include href="asn1_introduction.xml"/> + <xi:include href="asn1_overview.xml"/> + <xi:include href="asn1_getting_started.xml"/> <xi:include href="asn1_spec.xml"/> </part> diff --git a/lib/asn1/doc/src/ref_man.xml b/lib/asn1/doc/src/ref_man.xml index 0a0ed5416a..e157f542f3 100644 --- a/lib/asn1/doc/src/ref_man.xml +++ b/lib/asn1/doc/src/ref_man.xml @@ -21,7 +21,7 @@ </legalnotice> - <title>Asn1 Reference Manual</title> + <title>ASN.1 Reference Manual</title> <prepared>OTP Team</prepared> <docno></docno> <date>1997-10-04</date> @@ -29,8 +29,8 @@ <file>application.sgml</file> </header> <description> - <p>The <em>Asn1</em> application - contains modules with compile-time and run-time support for ASN.1.</p> + <p>The <c>ASN.1</c> application + contains modules with compile-time and runtime support for ASN.1.</p> </description> <xi:include href="asn1ct.xml"/> <xi:include href="asn1rt.xml"/> diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 580d5dbd7b..0be1466fc9 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -63,9 +63,10 @@ ct_master_logs]}, {applications, [kernel,stdlib]}, {env, []}, - {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", - "test_server-3.7.1","stdlib-2.0","ssh-3.0.1", - "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", - "kernel-3.0","inets-5.10","erts-6.0", - "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. + {runtime_dependencies,["xmerl-1.3.8","tools-2.8", + "test_server-3.9","stdlib-2.5","ssh-4.0", + "snmp-5.1.2","sasl-2.4.2","runtime_tools-1.8.16", + "kernel-4.0","inets-6.0","erts-7.0", + "debugger-4.1","crypto-3.6","compiler-6.0", + "observer-2.1"]}]}. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index b37baa9f3e..0eafe72020 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1634,11 +1634,15 @@ groups_and_cases(Gs, Cs) -> tests(TestDir, Suites, []) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suites),ensure_atom(Suites),all}]; tests(TestDir, Suite, Cases) when is_list(TestDir), is_integer(hd(TestDir)) -> + [{?testdir(TestDir,Suite),ensure_atom(Suite),Cases}]; +tests([TestDir], Suite, Cases) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suite),ensure_atom(Suite),Cases}]. tests([{Dir,Suite}],Cases) -> [{?testdir(Dir,Suite),ensure_atom(Suite),Cases}]; tests(TestDir, Suite) when is_list(TestDir), is_integer(hd(TestDir)) -> - tests(TestDir, ensure_atom(Suite), all). + tests(TestDir, ensure_atom(Suite), all); +tests([TestDir], Suite) when is_list(TestDir), is_integer(hd(TestDir)) -> + tests(TestDir, ensure_atom(Suite), all). tests(DirSuites) when is_list(DirSuites), is_tuple(hd(DirSuites)) -> [{?testdir(Dir,Suite),ensure_atom(Suite),all} || {Dir,Suite} <- DirSuites]; tests(TestDir) when is_list(TestDir), is_integer(hd(TestDir)) -> diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index e2d921729c..ff2bd20ab3 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.10.1 +COMMON_TEST_VSN = 1.11 diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index b54d125774..22810c910c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -920,28 +920,35 @@ transform_module(#compile{options=Opt,code=Code0}=St0) -> foldl_transform(St, [T|Ts]) -> Name = "transform " ++ atom_to_list(T), - Fun = fun(S) -> T:parse_transform(S#compile.code, S#compile.options) end, - Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end - end, - case Run({Name, Fun}, St) of - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}}; - {'EXIT',{undef,_}} -> - Es = [{St#compile.ifile,[{none,compile, - {undef_parse_transform,T}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {'EXIT',R} -> - Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); - Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + case code:ensure_loaded(T) =:= {module,T} andalso + erlang:function_exported(T, parse_transform, 2) of + true -> + Fun = fun(S) -> + T:parse_transform(S#compile.code, S#compile.options) + end, + Run = case member(time, St#compile.options) of + true -> fun run_tc/2; + false -> fun({_Name,F}, S) -> catch F(S) end + end, + case Run({Name, Fun}, St) of + {error,Es,Ws} -> + {error,St#compile{warnings=St#compile.warnings ++ Ws, + errors=St#compile.errors ++ Es}}; + {'EXIT',R} -> + Es = [{St#compile.ifile,[{none,compile, + {parse_transform,T,R}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; + {warning, Forms, Ws} -> + foldl_transform( + St#compile{code=Forms, + warnings=St#compile.warnings ++ Ws}, Ts); + Forms -> + foldl_transform(St#compile{code=Forms}, Ts) + end; + false -> + Es = [{St#compile.ifile,[{none,compile, + {undef_parse_transform,T}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}} end; foldl_transform(St, []) -> {ok,St}. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 0d23f12fb5..acd785cc5a 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -235,10 +235,18 @@ transforms(Config) -> ">>, {error,[{none,compile,{parse_transform,?MODULE,{too_bad,_}}}],[]} = run_test(Ts2, test_filename(Config), [], dont_write_beam), + Ts3 = <<" + -compile({parse_transform,",?MODULE_STRING,"}). + ">>, + {error,[{none,compile,{parse_transform,?MODULE,{undef,_}}}],[]} = + run_test(Ts3, test_filename(Config), [call_undef], dont_write_beam), ok. -parse_transform(_, _) -> - error(too_bad). +parse_transform(_, Opts) -> + case lists:member(call_undef, Opts) of + false -> error(too_bad); + true -> camembert:délicieux() + end. maps_warnings(Config) when is_list(Config) -> diff --git a/lib/cosEvent/src/cosEvent.app.src b/lib/cosEvent/src/cosEvent.app.src index 66b0d2e168..5ffd12bc6b 100644 --- a/lib/cosEvent/src/cosEvent.app.src +++ b/lib/cosEvent/src/cosEvent.app.src @@ -39,7 +39,7 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosEventApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl b/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl index 5f2733e72d..9c22eafaab 100644 --- a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl +++ b/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -251,7 +251,8 @@ send_sync(_OE_This, _OE_From, State, Any) -> store_event(DB, Max, Event) -> case ets:info(DB, size) of CurrentSize when CurrentSize < Max -> - ets:insert(DB, {now(), Event}); + ets:insert(DB, {{erlang:system_time(), erlang:unique_integer([positive])}, + Event}); _ -> orber:dbg("[~p] oe_CosEventComm_PullerS:store_event(~p); DB full drop event.", [?LINE, Event], ?DEBUG_LEVEL), diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk index 40bf1ba49d..3149020d7c 100644 --- a/lib/cosEvent/vsn.mk +++ b/lib/cosEvent/vsn.mk @@ -1,3 +1,2 @@ - -COSEVENT_VSN = 2.1.15 +COSEVENT_VSN = 2.2 diff --git a/lib/cosEventDomain/src/cosEventDomain.app.src b/lib/cosEventDomain/src/cosEventDomain.app.src index 60114b6a91..f218ac853e 100644 --- a/lib/cosEventDomain/src/cosEventDomain.app.src +++ b/lib/cosEventDomain/src/cosEventDomain.app.src @@ -28,6 +28,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosEventDomainApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosNotification-1.1.21"]} ]}. diff --git a/lib/cosEventDomain/src/cosEventDomainApp.erl b/lib/cosEventDomain/src/cosEventDomainApp.erl index 734e4deccb..86069d9e09 100644 --- a/lib/cosEventDomain/src/cosEventDomainApp.erl +++ b/lib/cosEventDomain/src/cosEventDomainApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,9 +36,6 @@ %%--------------- EXPORTS ------------------------------------ %% External MISC -export([get_option/3, - create_name/2, - create_name/1, - create_id/0, create_id/1, is_debug_compiled/0, install/0, @@ -222,31 +219,10 @@ get_option(Key, OptionList, DefaultList) -> {error, "Invalid option"} end end. -%%-----------------------------------------------------------% -%% function : create_name/2 -%% Arguments: -%% Returns : -%% Exception: -%% Effect : -%%------------------------------------------------------------ -create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). - -%%-----------------------------------------------------------% -%% function : create_name/1 -%% Arguments: -%% Returns : -%% Exception: -%% Effect : -%%------------------------------------------------------------ -create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). %%------------------------------------------------------------ -%% function : create_id/0 -%% Arguments: - +%% function : create_id/1 +%% Arguments: CosEventDomainAdmin::DomainID (long) %% Returns : CosEventDomainAdmin::DomainID (long) %% Exception: %% Purpose : @@ -256,10 +232,6 @@ create_id(2147483647) -> create_id(OldID) -> OldID+1. - -create_id() -> - {_A,_B,C}=now(), - C. %%------------------------------------------------------------ %% function : get_qos %% Arguments: diff --git a/lib/cosEventDomain/vsn.mk b/lib/cosEventDomain/vsn.mk index 6317ed3c22..bdde1f6ab2 100644 --- a/lib/cosEventDomain/vsn.mk +++ b/lib/cosEventDomain/vsn.mk @@ -1,3 +1,2 @@ - -COSEVENTDOMAIN_VSN = 1.1.14 +COSEVENTDOMAIN_VSN = 1.2 diff --git a/lib/cosFileTransfer/src/cosFileTransfer.app.src b/lib/cosFileTransfer/src/cosFileTransfer.app.src index 21226b0c6b..033eec9700 100644 --- a/lib/cosFileTransfer/src/cosFileTransfer.app.src +++ b/lib/cosFileTransfer/src/cosFileTransfer.app.src @@ -38,6 +38,6 @@ {env, []}, {mod, {cosFileTransferApp, []}}, {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","orber-3.6.27","kernel-3.0", - "inets-5.10","erts-6.0","cosProperty-1.1.17"]} + "inets-5.10","erts-7.0","cosProperty-1.1.17"]} ]}. diff --git a/lib/cosFileTransfer/src/cosFileTransferApp.erl b/lib/cosFileTransfer/src/cosFileTransferApp.erl index 443c917a97..bcc9f485a0 100644 --- a/lib/cosFileTransfer/src/cosFileTransferApp.erl +++ b/lib/cosFileTransfer/src/cosFileTransferApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -208,8 +208,9 @@ type_check(Obj, Mod) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%-----------------------------------------------------------% diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl index dfe6fabfab..5e75a9919f 100644 --- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl +++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl @@ -732,8 +732,9 @@ create_file_on_source_node({'NATIVE', _}, _Config, Host, FileName, Path, Data) - ?match(ok, file:write_file(FileName, list_to_binary(Data))). create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat([Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat([Type, '_', Time, '_', Unique]). diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk index f52a1bd800..00bfdb3087 100644 --- a/lib/cosFileTransfer/vsn.mk +++ b/lib/cosFileTransfer/vsn.mk @@ -1 +1 @@ -COSFILETRANSFER_VSN = 1.1.16 +COSFILETRANSFER_VSN = 1.2 diff --git a/lib/cosNotification/src/CosNotification_Common.erl b/lib/cosNotification/src/CosNotification_Common.erl index af9b2d4368..cdaaeee7f8 100644 --- a/lib/cosNotification/src/CosNotification_Common.erl +++ b/lib/cosNotification/src/CosNotification_Common.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -39,8 +39,9 @@ %%--------------- EXPORTS ------------------------------------ %% External MISC -export([get_option/3, - create_name/2, + create_name/0, create_name/1, + create_name/2, create_id/0, create_id/1, is_debug_compiled/0, @@ -110,17 +111,20 @@ get_option(Key, OptionList, DefaultList) -> {error, "Invalid option"} end end. -%%-----------------------------------------------------------% -%% function : create_name/2 + +%%------------------------------------------------------------ +%% function : create_name %% Arguments: %% Returns : -%% Exception: -%% Effect : +%% Effect : Create a unique name to use when, for eaxmple, starting +%% a new server. %%------------------------------------------------------------ -create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). - +create_name() -> + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Time,'_',Unique]). + + %%-----------------------------------------------------------% %% function : create_name/1 %% Arguments: @@ -129,8 +133,21 @@ create_name(Name,Type) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). + +%%-----------------------------------------------------------% +%% function : create_name/2 +%% Arguments: +%% Returns : +%% Exception: +%% Effect : +%%------------------------------------------------------------ +create_name(Name,Type) -> + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : create_id/0 @@ -146,16 +163,16 @@ create_name(Type) -> %%------------------------------------------------------------ create_id(-1) -> 1; -create_id( 2147483647) -> +create_id(2147483647) -> -2147483648; create_id(OldID) -> OldID+1. create_id() -> - {_A,_B,C}=now(), + {_A,_B,C}=erlang:timestamp(), C. -%%-----------------------------------------------------------% +%%------------------------------------------------------------ %% function : type_check %% Arguments: Obj - objectrefernce to test. %% Mod - Module which contains typeID/0. diff --git a/lib/cosNotification/src/CosNotification_Definitions.hrl b/lib/cosNotification/src/CosNotification_Definitions.hrl index 8325b5aa5e..5db081ec2e 100644 --- a/lib/cosNotification/src/CosNotification_Definitions.hrl +++ b/lib/cosNotification/src/CosNotification_Definitions.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -315,7 +315,9 @@ {tty, false}, {logfile, false}, {server_options, []}]). --define(not_CreateDBKey, term_to_binary({now(), node()})). +-define(not_CreateDBKey, term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()})). -define(DEBUG_LEVEL, 3). diff --git a/lib/cosNotification/src/PullerSupplier_impl.erl b/lib/cosNotification/src/PullerSupplier_impl.erl index 9f12f9c742..22e8355f3a 100644 --- a/lib/cosNotification/src/PullerSupplier_impl.erl +++ b/lib/cosNotification/src/PullerSupplier_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -887,7 +887,7 @@ callAny(_OE_THIS, OE_FROM, State, EventIn, Status) -> %% Start timers which send a message each time we should push events. Only used %% when this objects is defined to supply sequences. start_timer(State) -> - TS = now(), + TS = erlang:timestamp(), case catch timer:send_after(timer:seconds(?get_PacingInterval(State)), {pacing, TS}) of {ok,PacTRef} -> diff --git a/lib/cosNotification/src/cosNotification.app.src b/lib/cosNotification/src/cosNotification.app.src index ad02eb4421..09bf8f01fc 100644 --- a/lib/cosNotification/src/cosNotification.app.src +++ b/lib/cosNotification/src/cosNotification.app.src @@ -117,6 +117,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosNotificationApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosTime-1.1.14","cosEvent-2.1.15"]} ]}. diff --git a/lib/cosNotification/src/cosNotificationApp.erl b/lib/cosNotification/src/cosNotificationApp.erl index ba44163272..251779c558 100644 --- a/lib/cosNotification/src/cosNotificationApp.erl +++ b/lib/cosNotification/src/cosNotificationApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -221,7 +221,7 @@ start_global_factory() -> start_global_factory(Args) when is_list(Args) -> SO = 'CosNotification_Common':get_option(server_options, Args, ?not_DEFAULT_SETTINGS), - Name = create_name(), + Name = 'CosNotification_Common':create_name(), SPEC = ['CosNotifyChannelAdmin_EventChannelFactory',Args, [{sup_child, true}, {regname, {global, Name}}|SO]], @@ -432,16 +432,4 @@ init(app_init) -> 'CosNotifyChannelAdmin_EventChannel_impl']}]}}. - -%%------------------------------------------------------------ -%% function : create_name -%% Arguments: -%% Returns : -%% Effect : Create a unique name to use when, for eaxmple, starting -%% a new server. -%%------------------------------------------------------------ -create_name() -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',MSec, '_', Sec, '_', USec]). - %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosNotification/src/cosNotification_eventDB.erl b/lib/cosNotification/src/cosNotification_eventDB.erl index 89332d53f2..f8e2384d15 100644 --- a/lib/cosNotification/src/cosNotification_eventDB.erl +++ b/lib/cosNotification/src/cosNotification_eventDB.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -71,10 +71,8 @@ %% that the first and last Key change place. {K1,K2}<->{K2,K1} and %% {K1,K2,K3}<->{K3,K2,K1}. %%---------------------------------------------------------------------- - -module(cosNotification_eventDB). - %%--------------- INCLUDES ----------------------------------- -include_lib("orber/include/corba.hrl"). -include_lib("orber/include/ifr_types.hrl"). @@ -221,16 +219,16 @@ gc_events(DBRef, _Priority) when ?is_TimeoutNotUsed(DBRef) -> gc_events(DBRef, _Priority) when ?is_StopTNotSupported(DBRef) -> ok; gc_events(DBRef, Priority) -> - {M,S,U} = now(), + TS = erlang:monotonic_time(), + {resolution, TR} = lists:keyfind(resolution, 1, erlang:system_info(os_monotonic_time_source)), case get(oe_GC_timestamp) of - Num when {M,S,U} > Num -> - put(oe_GC_timestamp, {M,S+?get_GCTime(DBRef),U}), + Num when TS > Num -> + put(oe_GC_timestamp, TS + ?get_GCTime(DBRef) * TR), spawn_link(?MODULE, gc_start, [DBRef, Priority]); _-> ok end. - %%------------------------------------------------------------ %% function : gc_start %% Arguments: @@ -266,13 +264,13 @@ gc_discard_DB({Key1, Key2, Key3}, DRef) -> %% Returns : %%------------------------------------------------------------ create_FIFO_Key() -> - {M, S, U} = erlang:now(), + {M, S, U} = erlang:timestamp(), -M*1000000000000 - S*1000000 - U. %%------------------------------------------------------------ %% function : convert_FIFO_Key %% Arguments: -%% Returns : A now tuple +%% Returns : A timestamp tuple %% Comment : Used when we must reuse a timestamp, i.e., only %% when we must reorder the DB. %%------------------------------------------------------------ @@ -322,7 +320,7 @@ extract_start_time(#'CosNotification_StructuredEvent' _ -> false end, - convert_time(ST, TRef, now()); + convert_time(ST, TRef, erlang:timestamp()); extract_start_time(_, _, _) -> false. @@ -337,12 +335,12 @@ extract_start_time(_, _, _) -> %% - undefined eq. value needed but no filter associated. %% Now - used when we want to reuse old TimeStamp which %% must be done when changing QoS. -%% Returns : A modified return from now(). +%% Returns : A modified return from erlang:timestamp(). %%------------------------------------------------------------ extract_deadline(_, _, _, _, false) -> false; extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal) -> - extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal, now()). + extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal, erlang:timestamp()). extract_deadline(_, _, _, _, false, _) -> false; @@ -403,14 +401,14 @@ get_time_diff(UTC, TRef) -> UB-LB. check_deadline(DL) when is_tuple(DL) -> - {M,S,U} = now(), + {M,S,U} = erlang:timestamp(), DL >= {-M,-S,-U}; check_deadline(_DL) -> %% This case will cover if no timeout is set. false. check_start_time(ST) when is_tuple(ST) -> - {M,S,U} = now(), + {M,S,U} = erlang:timestamp(), ST >= {-M,-S,-U}; check_start_time(_ST) -> %% This case will cover if no earliest delivery time is set. @@ -1139,8 +1137,10 @@ create_db(QoS, GCTime, GCLimit, TimeRef) -> ?is_TimeoutNotUsed(DBRef), ?is_StopTNotSupported(DBRef) -> ok; true -> - {M,S,U} = now(), - put(oe_GC_timestamp, {M,S+GCTime,U}) + TS = erlang:monotonic_time(), + {resolution, TR} = lists:keyfind(resolution, 1, + erlang:system_info(os_monotonic_time_source)), + put(oe_GC_timestamp, TS+GCTime*TR) end, DBRef. diff --git a/lib/cosNotification/test/notify_test_impl.erl b/lib/cosNotification/test/notify_test_impl.erl index dae7777089..4fe246ef16 100644 --- a/lib/cosNotification/test/notify_test_impl.erl +++ b/lib/cosNotification/test/notify_test_impl.erl @@ -289,10 +289,10 @@ disconnect_pull_supplier(_Self, State) -> %%--------------- LOCAL FUNCTIONS ---------------------------- delay(Obj, Event, Time, Mod, F) -> - io:format("notify_test:delay(~p) TIME: ~p~n",[Event, now()]), + io:format("notify_test:delay(~p) TIME: ~p~n",[Event, erlang:timestamp()]), timer:sleep(Time), Mod:F(Obj, Event), - io:format("notify_test:delay() DONE: ~p~n",[now()]), + io:format("notify_test:delay() DONE: ~p~n",[erlang:timestamp()]), ok. %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk index 28d6ec71bf..c1affdf0de 100644 --- a/lib/cosNotification/vsn.mk +++ b/lib/cosNotification/vsn.mk @@ -1,2 +1,2 @@ -COSNOTIFICATION_VSN = 1.1.21 +COSNOTIFICATION_VSN = 1.2 diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl index 157b243c53..788518c7bb 100644 --- a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl +++ b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -128,7 +128,9 @@ %% {stop, Reason} %%---------------------------------------------------------------------- init({DefMode, AllowedTypes, AllowedProperties, InitProperties, MyType}) -> - Key = term_to_binary({now(), node()}), + Key = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), _F = ?write_function(#oe_CosPropertyService{key=Key, properties=InitProperties}), write_result(mnesia:transaction(_F)), diff --git a/lib/cosProperty/src/cosProperty.app.src b/lib/cosProperty/src/cosProperty.app.src index b977bb5984..7fad7a602a 100644 --- a/lib/cosProperty/src/cosProperty.app.src +++ b/lib/cosProperty/src/cosProperty.app.src @@ -43,5 +43,5 @@ {env, []}, {mod, {cosProperty, []}}, {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","mnesia-4.12", - "kernel-3.0","erts-6.0"]} + "kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosProperty/src/cosProperty.erl b/lib/cosProperty/src/cosProperty.erl index 2368ee3db6..57c35dedf9 100644 --- a/lib/cosProperty/src/cosProperty.erl +++ b/lib/cosProperty/src/cosProperty.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -406,8 +406,9 @@ type_check(Obj, Mod) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk index 0f546a2da8..d96508c2d2 100644 --- a/lib/cosProperty/vsn.mk +++ b/lib/cosProperty/vsn.mk @@ -1,2 +1,2 @@ -COSPROPERTY_VSN = 1.1.17 +COSPROPERTY_VSN = 1.2 diff --git a/lib/cosTime/src/CosTime_TimeService_impl.erl b/lib/cosTime/src/CosTime_TimeService_impl.erl index bac4ae087c..f44e7ba2f4 100644 --- a/lib/cosTime/src/CosTime_TimeService_impl.erl +++ b/lib/cosTime/src/CosTime_TimeService_impl.erl @@ -166,7 +166,7 @@ new_interval(_, _, _, _) -> create_universal_time() -> %% Time is supposed to be #100 nano-secs passed. %% We add micro secs for a greater precision. - {MS,S,US} = now(), + {MS,S,US} = erlang:timestamp(), case catch calendar:datetime_to_gregorian_seconds( calendar:now_to_universal_time({MS,S,US})) of Secs when is_integer(Secs) -> diff --git a/lib/cosTime/src/cosTime.app.src b/lib/cosTime/src/cosTime.app.src index cd01de35cb..ac71fe1b29 100644 --- a/lib/cosTime/src/cosTime.app.src +++ b/lib/cosTime/src/cosTime.app.src @@ -27,6 +27,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosTime, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosEvent-2.1.15"]} ]}. diff --git a/lib/cosTime/src/cosTime.erl b/lib/cosTime/src/cosTime.erl index f7d03650af..45f305df39 100644 --- a/lib/cosTime/src/cosTime.erl +++ b/lib/cosTime/src/cosTime.erl @@ -333,8 +333,9 @@ type_check(Obj, Mod) -> %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosTime/src/cosTimeApp.hrl b/lib/cosTime/src/cosTimeApp.hrl index f3082816f7..bdf0bf7278 100644 --- a/lib/cosTime/src/cosTimeApp.hrl +++ b/lib/cosTime/src/cosTimeApp.hrl @@ -41,7 +41,7 @@ -define(max_TimeT, 18446744073709551616). %% The calendar module uses year 0 as base for gregorian functions. -%% 'ABSOULTE_TIME_DIFF' is #seconfs from year 0 until 15 october 1582, 00:00. +%% 'ABSOULTE_TIME_DIFF' is #seconds from year 0 until 15 october 1582, 00:00. -define(ABSOLUTE_TIME_DIFF, 49947926400). %% As above but diff year 0 to 00:00 GMT, January 1, 1970 -define(STANDARD_TIME_DIFF, 62167219200). diff --git a/lib/cosTime/vsn.mk b/lib/cosTime/vsn.mk index 9e9e5c0250..32416f0087 100644 --- a/lib/cosTime/vsn.mk +++ b/lib/cosTime/vsn.mk @@ -1,3 +1,2 @@ -COSTIME_VSN = 1.1.14 - +COSTIME_VSN = 1.2 diff --git a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl index 36e37e2d5f..3954f04ad3 100644 --- a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl +++ b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -145,8 +145,8 @@ create(_Self, State, TimeOut) when is_integer(TimeOut) -> _ -> if TimeOut > 0 -> - {MegaSecs, Secs, _Microsecs} = erlang:now(), - EState2 = ?tr_set_alarm(EState, MegaSecs*1000000+Secs+TimeOut), + TimeStampSec = erlang:monotonic_time(seconds), + EState2 = ?tr_set_alarm(EState, TimeStampSec+TimeOut), EState3 = ?tr_set_timeout(EState2, TimeOut*1000), ETraP = ?tr_start_child(?SUP_ETRAP(EState3)), {reply, ETraP, State}; diff --git a/lib/cosTransactions/src/ETraP_Common.erl b/lib/cosTransactions/src/ETraP_Common.erl index dd68e9b038..dca1c1aaa9 100644 --- a/lib/cosTransactions/src/ETraP_Common.erl +++ b/lib/cosTransactions/src/ETraP_Common.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -86,8 +86,9 @@ get_option(Key, OptionList, DefaultList) -> %%------------------------------------------------------------ create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : create_name/1 @@ -98,8 +99,9 @@ create_name(Name,Type) -> %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : try_timeout @@ -114,10 +116,9 @@ try_timeout(TimeoutAt) -> infinity -> false; _-> - {MegaSecs, Secs, _Microsecs} = erlang:now(), - Time = MegaSecs*1000000+Secs, + TimeSec = erlang:monotonic_time(seconds), if - Time < TimeoutAt -> + TimeSec < TimeoutAt -> false; true -> true diff --git a/lib/cosTransactions/src/ETraP_Server_impl.erl b/lib/cosTransactions/src/ETraP_Server_impl.erl index e2c5d88f9d..db23d6c166 100644 --- a/lib/cosTransactions/src/ETraP_Server_impl.erl +++ b/lib/cosTransactions/src/ETraP_Server_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,8 @@ %% Log files are created in the current directory, which is why the %% application requires read/write rights for current directory. The %% file name looks like: -%% "oe_nonode@nohost_subc_939_383117_295538" (the last part is now()) +%% "oe_nonode@nohost_subc_1429872479809947099_438" (the two last parts are +%% erlang:system_time() and erlang:unique_integer([positive])) %% It is equal to what the object is started as, i.e., {regname, {global, X}}. %% %% If the application is unable to read the log it will exit and the diff --git a/lib/cosTransactions/src/cosTransactions.app.src b/lib/cosTransactions/src/cosTransactions.app.src index 6b99915ad6..074d82f487 100644 --- a/lib/cosTransactions/src/cosTransactions.app.src +++ b/lib/cosTransactions/src/cosTransactions.app.src @@ -40,5 +40,5 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosTransactions, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosTransactions/vsn.mk b/lib/cosTransactions/vsn.mk index 7aed212523..929f8c73d1 100644 --- a/lib/cosTransactions/vsn.mk +++ b/lib/cosTransactions/vsn.mk @@ -1 +1 @@ -COSTRANSACTIONS_VSN = 1.2.14 +COSTRANSACTIONS_VSN = 1.3 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 22c430bcd3..adacdcbc73 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -3749,7 +3749,7 @@ out: static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { #if defined(HAVE_EC) - EC_KEY *key; + EC_KEY *key = NULL; const EC_GROUP *group; const EC_POINT *public_key; ERL_NIF_TERM priv_key; diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 2a8bf6edcc..5f52906625 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -368,6 +368,7 @@ Option :: {files, [Filename :: string()]} | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} | {output_plt, FileName :: string()} + | {check_plt, boolean()}, | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index c9e7da9ef0..c8537e3bd8 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,14 +162,7 @@ run(Opts) -> {error, Msg} -> throw({dialyzer_error, Msg}); OptsRecord -> - case OptsRecord#options.check_plt of - true -> - case cl_check_init(OptsRecord) of - {ok, ?RET_NOTHING_SUSPICIOUS} -> ok; - {error, ErrorMsg1} -> throw({dialyzer_error, ErrorMsg1}) - end; - false -> ok - end, + ok = check_init(OptsRecord), case dialyzer_cl:start(OptsRecord) of {?RET_DISCREPANCIES, Warnings} -> Warnings; {?RET_NOTHING_SUSPICIOUS, _} -> [] @@ -179,6 +172,16 @@ run(Opts) -> erlang:error({dialyzer_error, lists:flatten(ErrorMsg)}) end. +check_init(#options{analysis_type = plt_check}) -> + ok; +check_init(#options{check_plt = true} = OptsRecord) -> + case cl_check_init(OptsRecord) of + {ok, _} -> ok; + {error, Msg} -> throw({dialyzer_error, Msg}) + end; +check_init(#options{check_plt = false}) -> + ok. + internal_gui(OptsRecord) -> F = fun() -> dialyzer_gui_wx:start(OptsRecord), @@ -199,17 +202,13 @@ gui(Opts) -> throw({dialyzer_error, Msg}); OptsRecord -> ok = check_gui_options(OptsRecord), - case cl_check_init(OptsRecord) of - {ok, ?RET_NOTHING_SUSPICIOUS} -> - F = fun() -> - dialyzer_gui_wx:start(OptsRecord) - end, - case doit(F) of - {ok, _} -> ok; - {error, Msg} -> throw({dialyzer_error, Msg}) - end; - {error, ErrorMsg1} -> - throw({dialyzer_error, ErrorMsg1}) + ok = check_init(OptsRecord), + F = fun() -> + dialyzer_gui_wx:start(OptsRecord) + end, + case doit(F) of + {ok, _} -> ok; + {error, Msg} -> throw({dialyzer_error, Msg}) end catch throw:{dialyzer_error, ErrorMsg} -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 1737bfd3a9..6c14860d7d 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1579,11 +1579,11 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, _State) -> eval_inv_arith('+', _Pos, Dst, Arg) -> bif_return(erlang, '-', 2, [Dst, Arg]); eval_inv_arith('*', _Pos, Dst, Arg) -> - case t_number_vals(Arg) of - [0] -> t_integer(); - _ -> + Zero = t_from_term(0), + case t_is_none(t_inf(Arg, Zero)) of + false -> t_integer(); + true -> TmpRet = bif_return(erlang, 'div', 2, [Dst, Arg]), - Zero = t_from_term(0), %% If 0 is not part of the result, it cannot be part of the argument. case t_is_subtype(Zero, Dst) of false -> t_subtract(TmpRet, Zero); diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ef4cdc57f0..ecbac14e5d 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -6,12 +6,13 @@ -include_lib("common_test/include/ct.hrl"). -include("dialyzer_test_constants.hrl"). --export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1]). +-export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, + run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt, beam_tests, update_plt]. +all() -> [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -37,14 +38,76 @@ beam_tests(Config) when is_list(Config) -> ">>, Opts = [no_auto_import], {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer([BeamFile]), + [] = run_dialyzer(plt_build, [BeamFile], []), ok. -run_dialyzer(Files) -> - dialyzer:run([{analysis_type, plt_build}, - {files, Files}, - {from, byte_code}, - {check_plt, false}]). +run_plt_check(Config) when is_list(Config) -> + Mod1 = <<" + -module(run_plt_check1). + ">>, + + Mod2A = <<" + -module(run_plt_check2). + ">>, + + {ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []), + {ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []), + [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []), + + Mod2B = <<" + -module(run_plt_check2). + + -export([call/1]). + + call(X) -> run_plt_check1:call(X). + ">>, + + {ok, BeamFile2} = compile(Config, Mod2B, run_plt_check2, []), + + % callgraph warning as run_plt_check2:call/1 makes a call to unexported + % function run_plt_check1:call/1. + [_] = run_dialyzer(plt_check, [], []), + + ok. + +run_succ_typings(Config) when is_list(Config) -> + Mod1A = <<" + -module(run_succ_typings1). + + -export([call/0]). + + call() -> a. + ">>, + + {ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []), + [] = run_dialyzer(plt_build, [BeamFile1], []), + + Mod1B = <<" + -module(run_succ_typings1). + + -export([call/0]). + + call() -> b. + ">>, + + Mod2 = <<" + -module(run_succ_typings2). + + -export([call/0]). + + -spec call() -> b. + call() -> run_succ_typings1:call(). + ">>, + + {ok, BeamFile1} = compile(Config, Mod1B, run_succ_typings1, []), + {ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []), + % contract types warning as run_succ_typings2:call/0 makes a call to + % run_succ_typings1:call/0, which returns a (not b) in the PLT. + [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]), + % warning not returned as run_succ_typings1 is updated in the PLT. + [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]), + + ok. %%% [James Fish:] %%% If a function is removed from a module and the module has previously @@ -103,3 +166,9 @@ compile(Config, Prog, Module, CompileOpts) -> Opts = [{outdir, PrivDir}, debug_info | CompileOpts], {ok, Module} = compile:file(Filename, Opts), {ok, filename:join([PrivDir, lists:concat([Module, ".beam"])])}. + +run_dialyzer(Analysis, Files, Opts) -> + dialyzer:run([{analysis_type, Analysis}, + {files, Files}, + {from, byte_code} | + Opts]). diff --git a/lib/dialyzer/test/small_SUITE_data/src/inv_mult.erl b/lib/dialyzer/test/small_SUITE_data/src/inv_mult.erl new file mode 100644 index 0000000000..3413556813 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/inv_mult.erl @@ -0,0 +1,15 @@ +%% Dialyzer was too constraining when checking the relation between the +%% arguments and result of a multiplication. We should not constrain an argument +%% if the other operand *may* be zero. +%% +%% Bug found by Kostis Sagonas, fixed by Stavros Aronis + +-module(inv_mult). +-compile(export_all). + +main(L) -> + N = -1 * length(L), + fact(N). + +fact(0) -> 1; +fact(N) -> N * fact(N-1). diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index ed35ee3a9c..a6fad8a857 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -403,7 +403,11 @@ filter() See present/1, substrings/2, <v>OptionalAttrs = [Attr]</v> <v>Attr = {matchingRule,string()} | {type,string()} | {dnAttributes,boolean()}</v> </type> - <desc> <p>Creates an extensible match filter. For example, <c>eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"caseExactMatch"}]))</c> creates a filter which performs a <c>caseExactMatch</c> on the attribute <c>sn</c> and matches with the value <c>"Bar"</c>. The default value of <c>dnAttributes</c> is <c>false</c>.</p> </desc> + <desc> <p>Creates an extensible match filter. For example, </p> + <code> + eldap:extensibleMatch("Bar", [{type,"sn"}, {matchingRule,"caseExactMatch"}])) + </code> + <p>creates a filter which performs a <c>caseExactMatch</c> on the attribute <c>sn</c> and matches with the value <c>"Bar"</c>. The default value of <c>dnAttributes</c> is <c>false</c>.</p> </desc> </func> <func> <name>'and'([Filter]) -> filter()</name> diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index 137c61b2d9..8d754e934c 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -896,9 +896,9 @@ client_timeout(Fun, Config) -> T = 1000, case eldap:open([Host], [{timeout,T},{port,Port}|Opts]) of {ok,H} -> - T0 = now(), + T0 = erlang:monotonic_time(), {error,{gen_tcp_error,timeout}} = Fun(H), - T_op = diff(T0,now()), + T_op = ms_passed(T0), ct:log("Time = ~p, Timeout spec = ~p",[T_op,T]), if T_op < T -> @@ -910,8 +910,12 @@ client_timeout(Fun, Config) -> Other -> ct:fail("eldap:open failed: ~p",[Other]) end. -diff({M1,S1,U1},{M2,S2,U2}) -> - ( ((M2-M1)*1000 + (S2-S1))*1000 + (U2-U1) ). +%% Help function, elapsed milliseconds since T0 +ms_passed(T0) -> + %% OTP 18 + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) / 1000. %%%---------------------------------------------------------------- init_ssl_certs_et_al(Config) -> diff --git a/lib/eunit/doc/overview.edoc b/lib/eunit/doc/overview.edoc index 872a017440..df716cdeea 100644 --- a/lib/eunit/doc/overview.edoc +++ b/lib/eunit/doc/overview.edoc @@ -569,6 +569,9 @@ Examples: ```?assertMatch({found, {fred, _}}, lookup(bloggs, Table))''' ```?assertMatch([X|_] when X > 0, binary_to_list(B))''' </dd> +<dt>`assertNotMatch(GuardedPattern, Expr)'</dt> +<dd>The inverse case of assertMatch, for convenience. +</dd> <dt>`assertEqual(Expect, Expr)'</dt> <dd>Evaluates the expressions `Expect' and `Expr' and compares the results for equality, if testing is enabled. If the values are not @@ -583,6 +586,9 @@ Examples: ```?assertEqual("b" ++ "a", lists:reverse("ab"))''' ```?assertEqual(foo(X), bar(Y))''' </dd> +<dt>`assertNotEqual(Unexpected, Expr)'</dt> +<dd>The inverse case of assertEqual, for convenience. +</dd> <dt>`assertException(ClassPattern, TermPattern, Expr)'</dt> <dt>`assertError(TermPattern, Expr)'</dt> <dt>`assertExit(TermPattern, Expr)'</dt> diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 9e8d34567a..53d291430d 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -414,7 +414,7 @@ -else. -define(debugMsg(S), begin - io:fwrite(user, <<"~s:~w:~w: ~s\n">>, + io:fwrite(user, <<"~ts:~w:~w: ~ts\n">>, [?FILE, ?LINE, self(), S]), ok end). @@ -423,7 +423,7 @@ -define(debugVal(E), begin ((fun (__V) -> - ?debugFmt(<<"~s = ~P">>, [(??E), __V, 15]), + ?debugFmt(<<"~ts = ~tP">>, [(??E), __V, 15]), __V end)(E)) end). @@ -433,7 +433,7 @@ {__T0, _} = statistics(wall_clock), __V = (E), {__T1, _} = statistics(wall_clock), - ?debugFmt(<<"~s: ~.3f s">>, [(S), (__T1-__T0)/1000]), + ?debugFmt(<<"~ts: ~.3f s">>, [(S), (__T1-__T0)/1000]), __V end)()) end). diff --git a/lib/eunit/src/eunit.erl b/lib/eunit/src/eunit.erl index 9c589dfa86..fbfd123c43 100644 --- a/lib/eunit/src/eunit.erl +++ b/lib/eunit/src/eunit.erl @@ -231,7 +231,7 @@ event_logger(LogFile) -> event_logger_loop(Reference, FD) -> receive {status, _Id, _Info}=Msg -> - io:fwrite(FD, "~p.\n", [Msg]), + io:fwrite(FD, "~tp.\n", [Msg]), event_logger_loop(Reference, FD); {stop, Reference, _ReplyTo} -> %% no need to reply, just exit diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index cbbc6fbc15..8b53a3681d 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -391,7 +391,7 @@ parse({with, X, As}=T) when is_list(As) -> parse({S, T1} = T) when is_list(S) -> case eunit_lib:is_string(S) of true -> - group(#group{tests = T1, desc = list_to_binary(S)}); + group(#group{tests = T1, desc = unicode:characters_to_binary(S)}); false -> bad_test(T) end; diff --git a/lib/eunit/src/eunit_internal.hrl b/lib/eunit/src/eunit_internal.hrl index 92694ec39b..8e1e27811f 100644 --- a/lib/eunit/src/eunit_internal.hrl +++ b/lib/eunit/src/eunit_internal.hrl @@ -14,8 +14,8 @@ -define(DEFAULT_MODULE_WRAPPER_NAME, eunit_wrapper_). -ifdef(DEBUG). --define(debugmsg(S),io:fwrite("\n* ~s: ~s\n", [?MODULE,S])). --define(debugmsg1(S,As),io:fwrite("\n* ~s: " ++ S ++ "\n", [?MODULE] ++ As)). +-define(debugmsg(S),io:fwrite("\n* ~ts: ~ts\n", [?MODULE,S])). +-define(debugmsg1(S,As),io:fwrite("\n* ~ts: " ++ S ++ "\n", [?MODULE] ++ As)). -else. -define(debugmsg(S),ok). -define(debugmsg1(S,As),ok). diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index 40bae93298..d8f98cffa5 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -57,7 +57,7 @@ format_exception({Class,Term,Trace}, Depth) when is_atom(Class), is_list(Trace) -> case is_stacktrace(Trace) of true -> - io_lib:format("~s**~w:~s", + io_lib:format("~ts**~w:~ts", [format_stacktrace(Trace), Class, format_term(Term, Depth)]); false -> @@ -67,11 +67,11 @@ format_exception(Term, Depth) -> format_term(Term, Depth). format_term(Term, Depth) -> - io_lib:format("~P\n", [Term, Depth]). + io_lib:format("~tP\n", [Term, Depth]). format_exit_term(Term) -> {Reason, Trace} = analyze_exit_term(Term), - io_lib:format("~P~s", [Reason, 15, Trace]). + io_lib:format("~tP~ts", [Reason, 15, Trace]). analyze_exit_term({Reason, [_|_]=Trace}=Term) -> case is_stacktrace(Trace) of @@ -102,7 +102,7 @@ format_stacktrace(Trace) -> format_stacktrace(Trace, "in function", "in call from"). format_stacktrace([{M,F,A,L}|Fs], Pre, Pre1) when is_integer(A) -> - [io_lib:fwrite("~s ~w:~w/~w~s\n", + [io_lib:fwrite("~ts ~w:~w/~w~ts\n", [Pre, M, F, A, format_stacktrace_location(L)]) | format_stacktrace(Fs, Pre1, Pre1)]; format_stacktrace([{M,F,As,L}|Fs], Pre, Pre1) when is_list(As) -> @@ -110,15 +110,15 @@ format_stacktrace([{M,F,As,L}|Fs], Pre, Pre1) when is_list(As) -> C = case is_op(M,F,A) of true when A =:= 1 -> [A1] = As, - io_lib:fwrite("~s ~s", [F,format_arg(A1)]); + io_lib:fwrite("~ts ~ts", [F,format_arg(A1)]); true when A =:= 2 -> [A1, A2] = As, - io_lib:fwrite("~s ~s ~s", + io_lib:fwrite("~ts ~ts ~ts", [format_arg(A1),F,format_arg(A2)]); false -> - io_lib:fwrite("~w(~s)", [F,format_arglist(As)]) + io_lib:fwrite("~w(~ts)", [F,format_arglist(As)]) end, - [io_lib:fwrite("~s ~w:~w/~w~s\n called as ~s\n", + [io_lib:fwrite("~ts ~w:~w/~w~ts\n called as ~ts\n", [Pre,M,F,A,format_stacktrace_location(L),C]) | format_stacktrace(Fs,Pre1,Pre1)]; format_stacktrace([{M,F,As}|Fs], Pre, Pre1) -> @@ -130,18 +130,18 @@ format_stacktrace_location(Location) -> File = proplists:get_value(file, Location), Line = proplists:get_value(line, Location), if File =/= undefined, Line =/= undefined -> - io_lib:format(" (~s, line ~w)", [File, Line]); + io_lib:format(" (~ts, line ~w)", [File, Line]); true -> "" end. format_arg(A) -> - io_lib:format("~P",[A,15]). + io_lib:format("~tP",[A,15]). format_arglist([A]) -> format_arg(A); format_arglist([A|As]) -> - [io_lib:format("~P,",[A,15]) | format_arglist(As)]; + [io_lib:format("~tP,",[A,15]) | format_arglist(As)]; format_arglist([]) -> "". @@ -155,41 +155,41 @@ is_op(_M, _F, _A) -> false. format_error({bad_test, Term}) -> - error_msg("bad test descriptor", "~P", [Term, 15]); + error_msg("bad test descriptor", "~tP", [Term, 15]); format_error({bad_generator, {{M,F,A}, Term}}) -> error_msg(io_lib:format("result from generator ~w:~w/~w is not a test", [M,F,A]), - "~P", [Term, 15]); + "~tP", [Term, 15]); format_error({generator_failed, {{M,F,A}, Exception}}) -> error_msg(io_lib:format("test generator ~w:~w/~w failed",[M,F,A]), - "~s", [format_exception(Exception)]); + "~ts", [format_exception(Exception)]); format_error({no_such_function, {M,F,A}}) when is_atom(M), is_atom(F), is_integer(A) -> error_msg(io_lib:format("no such function: ~w:~w/~w", [M,F,A]), "", []); format_error({module_not_found, M}) -> - error_msg("test module not found", "~p", [M]); + error_msg("test module not found", "~tp", [M]); format_error({application_not_found, A}) when is_atom(A) -> error_msg("application not found", "~w", [A]); format_error({file_read_error, {_R, Msg, F}}) -> - error_msg("error reading file", "~s: ~s", [Msg, F]); + error_msg("error reading file", "~ts: ~ts", [Msg, F]); format_error({setup_failed, Exception}) -> - error_msg("context setup failed", "~s", + error_msg("context setup failed", "~ts", [format_exception(Exception)]); format_error({cleanup_failed, Exception}) -> - error_msg("context cleanup failed", "~s", + error_msg("context cleanup failed", "~ts", [format_exception(Exception)]); format_error({{bad_instantiator, {{M,F,A}, Term}}, _DummyException}) -> error_msg(io_lib:format("result from instantiator ~w:~w/~w is not a test", [M,F,A]), - "~P", [Term, 15]); + "~tP", [Term, 15]); format_error({instantiation_failed, Exception}) -> - error_msg("instantiation of subtests failed", "~s", + error_msg("instantiation of subtests failed", "~ts", [format_exception(Exception)]). error_msg(Title, Fmt, Args) -> Msg = io_lib:format("**"++Fmt, Args), % gets indentation right - io_lib:fwrite("*** ~s ***\n~s\n\n", [Title, Msg]). + io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). format_exception_test_() -> diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 03d1a18321..98ae31d54b 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -230,7 +230,7 @@ insulator_wait(Child, Parent, Buf, St) -> message_super(Id, {progress, 'begin', {Type, Data}}, St), insulator_wait(Child, Parent, [[] | Buf], St); {child, Child, Id, {'end', Status, Time}} -> - Data = [{time, Time}, {output, buffer_to_binary(hd(Buf))}], + Data = [{time, Time}, {output, lists:reverse(hd(Buf))}], message_super(Id, {progress, 'end', {Status, Data}}, St), insulator_wait(Child, Parent, tl(Buf), St); {child, Child, Id, {skipped, Reason}} -> @@ -272,9 +272,6 @@ kill_task(Child, St) -> exit(Child, kill), terminate_insulator(St). -buffer_to_binary([B]) when is_binary(B) -> B; % avoid unnecessary copying -buffer_to_binary(Buf) -> list_to_binary(lists:reverse(Buf)). - %% Unlinking before exit avoids polluting the parent process with exit %% signals from the insulator. The child process is already dead here. @@ -597,7 +594,7 @@ group_leader_loop(Runner, Wait, Buf) -> %% no more messages and nothing to wait for; we ought to %% have collected all immediately pending output now process_flag(priority, normal), - Runner ! {self(), buffer_to_binary(Buf)} + Runner ! {self(), lists:reverse(Buf)} end. group_leader_sync(G) -> diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index 2d1f0b1497..d6684f33cb 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -206,6 +206,7 @@ handle_cancel(test, Data, St) -> format_name({Module, Function, Arity}, Line) -> lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", integer_to_list(Arity), "_", integer_to_list(Line)]). + format_desc(undefined) -> ""; format_desc(Desc) when is_binary(Desc) -> @@ -279,7 +280,7 @@ write_report_to(TestSuite, FileDescriptor) -> %% Write the XML header. %% ---------------------------------------------------------------------------- write_header(FileDescriptor) -> - file:write(FileDescriptor, [<<"<?xml version=\"1.0\" encoding=\"UTF-8\" ?>">>, ?NEWLINE]). + io:format(FileDescriptor, "~ts~ts", [<<"<?xml version=\"1.0\" encoding=\"UTF-8\" ?>">>, ?NEWLINE]). %% ---------------------------------------------------------------------------- %% Write the testsuite start tag, with attributes describing the statistics @@ -303,7 +304,7 @@ write_start_tag( <<"\" time=\"">>, format_time(Time), <<"\" name=\"">>, escape_attr(Name), <<"\">">>, ?NEWLINE], - file:write(FileDescriptor, StartTag). + io:format(FileDescriptor, "~ts", [StartTag]). %% ---------------------------------------------------------------------------- %% Recursive function to write the test cases. @@ -317,7 +318,7 @@ write_testcases([TestCase| Tail], FileDescriptor) -> %% Write the testsuite end tag. %% ---------------------------------------------------------------------------- write_end_tag(FileDescriptor) -> - file:write(FileDescriptor, [<<"</testsuite>">>, ?NEWLINE]). + io:format(FileDescriptor, "~ts~ts", [<<"</testsuite>">>, ?NEWLINE]). %% ---------------------------------------------------------------------------- %% Write a test case, as a testcase tag. @@ -344,7 +345,7 @@ write_testcase( {ok, <<>>} -> [<<"/>">>, ?NEWLINE]; _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE] end, - file:write(FileDescriptor, [StartTag, ContentAndEndTag]). + io:format(FileDescriptor, "~ts~ts", [StartTag, ContentAndEndTag]). %% ---------------------------------------------------------------------------- %% Format the result of the test. @@ -427,7 +428,7 @@ escape_suitename([Char | Tail], Acc) -> escape_suitename(Tail, [Char | Acc]). %% Replace < with <, > with > and & with & %% ---------------------------------------------------------------------------- escape_text(Text) when is_binary(Text) -> escape_text(binary_to_list(Text)); -escape_text(Text) -> escape_xml(lists:flatten(Text), [], false). +escape_text(Text) -> escape_xml(to_utf8(lists:flatten(Text)), [], false). %% ---------------------------------------------------------------------------- @@ -435,7 +436,7 @@ escape_text(Text) -> escape_xml(lists:flatten(Text), [], false). %% Replace < with <, > with > and & with & %% ---------------------------------------------------------------------------- escape_attr(Text) when is_binary(Text) -> escape_attr(binary_to_list(Text)); -escape_attr(Text) -> escape_xml(lists:flatten(Text), [], true). +escape_attr(Text) -> escape_xml(to_utf8(lists:flatten(Text)), [], true). escape_xml([], Acc, _ForAttr) -> lists:reverse(Acc); escape_xml([$< | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $l, $& | Acc], ForAttr); @@ -443,3 +444,17 @@ escape_xml([$> | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $g, $& | Acc] escape_xml([$& | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $p, $m, $a, $& | Acc], ForAttr); escape_xml([$" | Tail], Acc, true) -> escape_xml(Tail, [$;, $t, $o, $u, $q, $& | Acc], true); % " escape_xml([Char | Tail], Acc, ForAttr) when is_integer(Char) -> escape_xml(Tail, [Char | Acc], ForAttr). + +%% the input may be utf8 or latin1; the resulting list is unicode +to_utf8(Desc) when is_binary(Desc) -> + case unicode:characters_to_list(Desc) of + {_,_,_} -> unicode:characters_to_list(Desc, latin1); + X -> X + end; +to_utf8(Desc) when is_list(Desc) -> + try + to_utf8(list_to_binary(Desc)) + catch + _:_ -> + Desc + end. diff --git a/lib/eunit/src/eunit_tty.erl b/lib/eunit/src/eunit_tty.erl index f21b2da3d3..699d2adaca 100644 --- a/lib/eunit/src/eunit_tty.erl +++ b/lib/eunit/src/eunit_tty.erl @@ -83,7 +83,7 @@ terminate({ok, Data}, St) -> sync_end(error) end; terminate({error, Reason}, _St) -> - fwrite("Internal error: ~P.\n", [Reason, 25]), + fwrite("Internal error: ~tP.\n", [Reason, 25]), sync_end(error). sync_end(Result) -> @@ -177,7 +177,7 @@ indent(_N) -> print_group_start(I, Desc) -> indent(I), - fwrite("~s\n", [Desc]). + fwrite("~ts\n", [Desc]). print_group_end(I, Time) -> if Time > 0 -> @@ -195,13 +195,13 @@ print_test_begin(I, Data) -> true -> io_lib:fwrite("~w:", [Line]) end, D = if Desc =:= "" ; Desc =:= undefined -> ""; - true -> io_lib:fwrite(" (~s)", [Desc]) + true -> io_lib:fwrite(" (~ts)", [Desc]) end, case proplists:get_value(source, Data) of {Module, Name, _Arity} -> - fwrite("~s:~s ~s~s...", [Module, L, Name, D]); + fwrite("~ts:~ts ~ts~ts...", [Module, L, Name, D]); _ -> - fwrite("~s~s...", [L, D]) + fwrite("~ts~ts...", [L, D]) end. print_test_end(Data) -> @@ -209,21 +209,21 @@ print_test_end(Data) -> T = if Time > 0 -> io_lib:fwrite("[~.3f s] ", [Time/1000]); true -> "" end, - fwrite("~sok\n", [T]). + fwrite("~tsok\n", [T]). print_test_error({error, Exception}, Data) -> Output = proplists:get_value(output, Data), - fwrite("*failed*\n~s", [eunit_lib:format_exception(Exception)]), + fwrite("*failed*\n~ts", [eunit_lib:format_exception(Exception)]), case Output of <<>> -> fwrite("\n\n"); <<Text:800/binary, _:1/binary, _/binary>> -> - fwrite(" output:<<\"~s\">>...\n\n", [Text]); + fwrite(" output:<<\"~ts\">>...\n\n", [Text]); _ -> - fwrite(" output:<<\"~s\">>\n\n", [Output]) + fwrite(" output:<<\"~ts\">>\n\n", [Output]) end; print_test_error({skipped, Reason}, _) -> - fwrite("*did not run*\n::~s\n", [format_skipped(Reason)]). + fwrite("*did not run*\n::~ts\n", [format_skipped(Reason)]). format_skipped({module_not_found, M}) -> io_lib:fwrite("missing module: ~w", [M]); @@ -244,12 +244,12 @@ format_cancel(undefined) -> format_cancel(timeout) -> "*timed out*\n"; format_cancel({startup, Reason}) -> - io_lib:fwrite("*could not start test process*\n::~P\n\n", + io_lib:fwrite("*could not start test process*\n::~tP\n\n", [Reason, 15]); format_cancel({blame, _SubId}) -> "*cancelled because of subtask*\n"; format_cancel({exit, Reason}) -> - io_lib:fwrite("*unexpected termination of test process*\n::~P\n\n", + io_lib:fwrite("*unexpected termination of test process*\n::~tP\n\n", [Reason, 15]); format_cancel({abort, Reason}) -> eunit_lib:format_error(Reason). diff --git a/lib/eunit/test/Makefile b/lib/eunit/test/Makefile index e4ddf4e42c..b0dde64c67 100644 --- a/lib/eunit/test/Makefile +++ b/lib/eunit/test/Makefile @@ -20,7 +20,9 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ - eunit_SUITE + eunit_SUITE \ + tlatin \ + tutf8 ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/eunit/test/eunit_SUITE.erl b/lib/eunit/test/eunit_SUITE.erl index d13dc73923..2ac6fafe5d 100644 --- a/lib/eunit/test/eunit_SUITE.erl +++ b/lib/eunit/test/eunit_SUITE.erl @@ -1,35 +1,35 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(eunit_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - app_test/1,appup_test/1,eunit_test/1]). - + app_test/1,appup_test/1,eunit_test/1,surefire_utf8_test/1,surefire_latin_test/1]). + -include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [app_test, appup_test, eunit_test]. +all() -> + [app_test, appup_test, eunit_test, surefire_utf8_test, surefire_latin_test]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -54,3 +54,21 @@ eunit_test(Config) when is_list(Config) -> ok = file:set_cwd(code:lib_dir(eunit)), ok = eunit:test(eunit). +surefire_latin_test(Config) when is_list(Config) -> + ok = file:set_cwd(proplists:get_value(priv_dir, Config, ".")), + check_surefire(tlatin), + ok. + +surefire_utf8_test(Config) when is_list(Config) -> + ok = file:set_cwd(proplists:get_value(priv_dir, Config, ".")), + check_surefire(tutf8), + ok. + +check_surefire(Module) -> + File = "TEST-"++atom_to_list(Module)++".xml", + file:delete(File), + % ignore test result, some fail on purpose + eunit:test(Module, [{report,{eunit_surefire,[{dir,"."}]}}]), + {ok, Bin} = file:read_file(File), + [_|_] = unicode:characters_to_list(Bin, unicode), + ok.
\ No newline at end of file diff --git a/lib/eunit/test/tlatin.erl b/lib/eunit/test/tlatin.erl new file mode 100644 index 0000000000..a42e67d581 --- /dev/null +++ b/lib/eunit/test/tlatin.erl @@ -0,0 +1,15 @@ +% coding: latin-1 + +-module(tlatin). + +-include_lib("eunit/include/eunit.hrl"). + +'foo_�_test_'() -> + [ + {"1�1", fun() -> io:format("1�1 ~s ~w",[<<"a�">>, 'Z�k']), io:format([128,64,255,255]), ?assert("g�"=="g�") end} + ,{<<"2�2">>, fun() -> io:format("2�2 ~s",[<<"b�">>]), io:format([128,64]), ?assert("g�"=="g�") end} + ,{<<"3�3"/utf8>>, fun() -> io:format("3�3 ~ts",[<<"c�"/utf8>>]), io:format([128,64]), ?assert("g�"=="g�") end} + ,{"1�1", fun() -> io:format("1�1 ~s ~w",[<<"a�">>,'Zb�d']), io:format([128,64,255,255]), ?assert("w�"=="w�") end} + ,{<<"2�2">>, fun() -> io:format("2�2 ~s",[<<"b�">>]), io:format([128,64]), ?assert("w�"=="w�") end} + ,{<<"3�3"/utf8>>, fun() -> io:format("3�3 ~ts",[<<"c�"/utf8>>]), io:format([128,64]), ?assert("w�"=="w�") end} + ]. diff --git a/lib/eunit/test/tutf8.erl b/lib/eunit/test/tutf8.erl new file mode 100644 index 0000000000..c902f3ad18 --- /dev/null +++ b/lib/eunit/test/tutf8.erl @@ -0,0 +1,15 @@ +%% coding: utf-8 + +-module(tutf8). + +-include_lib("eunit/include/eunit.hrl"). + +'foo_ö_test_'() -> + [ + {"1ö汉1", fun() -> io:format("1å汉1 ~s ~w",[<<"aö汉">>, 'Zök']), io:format([128,64,255,255]), ?assert("gö汉"=="gö汉") end} + ,{<<"2ö汉2">>, fun() -> io:format("2å汉2 ~s",[<<"bö汉">>]), io:format([128,64]), ?assert("gö汉"=="gö汉") end} + ,{<<"3ö汉3"/utf8>>, fun() -> io:format("3å汉3 ~ts",[<<"cö汉"/utf8>>]), io:format([128,64]), ?assert("gö汉"=="gö汉") end} + ,{"1ä汉1", fun() -> io:format("1ä汉1 ~s ~w",[<<"aä汉">>, 'Zbäd']), io:format([128,64,255,255]), ?assert("wå汉"=="wä汉") end} + ,{<<"2ä汉2">>, fun() -> io:format("2ä汉2 ~s",[<<"bä汉">>]), io:format([128,64]), ?assert("wå汉"=="wä汉") end} + ,{<<"3ä汉"/utf8>>, fun() -> io:format("3ä汉3 ~ts",[<<"cä汉"/utf8>>]), io:format([128,64]), ?assert("wå汉"=="wä汉") end} + ]. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 798212d5f9..14335cf635 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -67,7 +67,6 @@ t_cons/2, t_cons_hd/1, t_cons_hd/2, t_cons_tl/1, t_cons_tl/2, - t_constant/0, t_contains_opaque/1, t_contains_opaque/2, t_decorate_with_opaque/3, t_elements/1, @@ -118,7 +117,6 @@ %% t_is_byte/1, %% t_is_char/1, t_is_cons/1, t_is_cons/2, - t_is_constant/1, t_is_equal/2, t_is_fixnum/1, t_is_float/1, t_is_float/2, @@ -1748,17 +1746,6 @@ is_tuple1(_) -> false. t_bitstrlist() -> t_iolist(1, t_bitstr()). -%% XXX. To be removed. --spec t_constant() -> erl_type(). - -t_constant() -> - t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]). - --spec t_is_constant(erl_type()) -> boolean(). - -t_is_constant(X) -> - t_is_subtype(X, t_constant()). - -spec t_arity() -> erl_type(). t_arity() -> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 12bbc2b736..bae8e327a3 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.7</title> + <section><title>Inets 5.10.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Reject messages with a Content-Length less than 0</p> + <p> + Own Id: OTP-12739 Aux Id: seq12860 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.7</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index dbdc1be272..a21eb915d4 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -785,8 +785,15 @@ fix_mime_types(ConfigList0) -> [{"html","text/html"},{"htm","text/html"}]} | ConfigList0] end; - _ -> - ConfigList0 + MimeTypes -> + case filelib:is_file(MimeTypes) of + true -> + {ok, MimeTypesList} = load_mime_types(MimeTypes), + ConfigList = proplists:delete(mime_types, ConfigList0), + [{mime_types, MimeTypesList} | ConfigList]; + false -> + ConfigList0 + end end. store({mime_types,MimeTypesList},ConfigList) -> diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 6985065c3e..3ff07616f9 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -417,8 +417,12 @@ check_header({"content-length", Value}, Maxsizes) -> case length(Value) =< MaxLen of true -> try - _ = list_to_integer(Value), - ok + list_to_integer(Value) + of + I when I>= 0 -> + ok; + _ -> + {error, {size_error, Max, 411, "negative content-length"}} catch _:_ -> {error, {size_error, Max, 411, "content-length not an integer"}} end; diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 11f2c6f298..7670c2cc60 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -66,7 +66,8 @@ all() -> {group, http_security}, {group, https_security}, {group, http_reload}, - {group, https_reload} + {group, https_reload}, + {group, http_mime_types} ]. groups() -> @@ -89,6 +90,7 @@ groups() -> {https_security, [], [{group, security}]}, {http_reload, [], [{group, reload}]}, {https_reload, [], [{group, reload}]}, + {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, {reload, [], [non_disturbing_reconfiger_dies, disturbing_reconfiger_dies, @@ -191,7 +193,8 @@ init_per_group(Group, Config0) when Group == http_basic; Group == http_auth_api_dets; Group == http_auth_api_mnesia; Group == http_security; - Group == http_reload + Group == http_reload; + Group == http_mime_types -> ok = start_apps(Group), init_httpd(Group, [{type, ip_comm} | Config0]); @@ -235,7 +238,8 @@ end_per_group(Group, _Config) when Group == http_basic; Group == http_auth_api_mnesia; Group == http_htaccess; Group == http_security; - Group == http_reload + Group == http_reload; + Group == http_mime_types -> inets:stop(); end_per_group(Group, _Config) when Group == https_basic; @@ -840,6 +844,24 @@ cgi_chunked_encoding_test(Config) when is_list(Config) -> ?config(node, Config), Requests). %%------------------------------------------------------------------------- +alias_1_1() -> + [{doc, "Test mod_alias"}]. + +alias_1_1(Config) when is_list(Config) -> + alias([{http_version, "HTTP/1.1"} | Config]). + +alias_1_0() -> + [{doc, "Test mod_alias"}]. + +alias_1_0(Config) when is_list(Config) -> + alias([{http_version, "HTTP/1.0"} | Config]). + +alias_0_9() -> + [{doc, "Test mod_alias"}]. + +alias_0_9(Config) when is_list(Config) -> + alias([{http_version, "HTTP/0.9"} | Config]). + alias() -> [{doc, "Test mod_alias"}]. @@ -898,7 +920,6 @@ trace(Config) when is_list(Config) -> Cb = ?config(version_cb, Config), Cb:trace(?config(type, Config), ?config(port, Config), ?config(host, Config), ?config(node, Config)). - %%------------------------------------------------------------------------- light() -> ["Test light load"]. @@ -1259,22 +1280,26 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> CgiDir = filename:join(ServerRoot, "cgi-bin"), AuthDir = filename:join(ServerRoot, "auth"), PicsDir = filename:join(ServerRoot, "icons"), + ConfigDir = filename:join(ServerRoot, "config"), ok = file:make_dir(ServerRoot), ok = file:make_dir(DocRoot), ok = file:make_dir(CgiDir), ok = file:make_dir(AuthDir), ok = file:make_dir(PicsDir), + ok = file:make_dir(ConfigDir), DocSrc = filename:join(DataDir, "server_root/htdocs"), AuthSrc = filename:join(DataDir, "server_root/auth"), CgiSrc = filename:join(DataDir, "server_root/cgi-bin"), PicsSrc = filename:join(DataDir, "server_root/icons"), + ConfigSrc = filename:join(DataDir, "server_root/config"), inets_test_lib:copy_dirs(DocSrc, DocRoot), inets_test_lib:copy_dirs(AuthSrc, AuthDir), inets_test_lib:copy_dirs(CgiSrc, CgiDir), inets_test_lib:copy_dirs(PicsSrc, PicsDir), + inets_test_lib:copy_dirs(ConfigSrc, ConfigDir), Cgi = case test_server:os_type() of {win32, _} -> @@ -1312,7 +1337,8 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api_mnesia; Group == https_htaccess; Group == https_security; - Group == https_reload-> + Group == https_reload; + Group == http_mime_types-> inets_test_lib:start_apps([inets]). server_start(_, HttpdConfig) -> @@ -1400,6 +1426,11 @@ server_config(http_security, Config) -> server_config(https_security, Config) -> ServerRoot = ?config(server_root, Config), tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(https, Config); +server_config(http_mime_types, Config0) -> + Config1 = basic_conf() ++ server_config(http, Config0), + ServerRoot = ?config(server_root, Config0), + MimeTypesFile = filename:join([ServerRoot,"config", "mime.types"]), + [{mime_types, MimeTypesFile} | proplists:delete(mime_types, Config1)]; server_config(http, Config) -> ServerRoot = ?config(server_root, Config), diff --git a/lib/inets/test/httpd_SUITE_data/server_root/config/mime.types b/lib/inets/test/httpd_SUITE_data/server_root/config/mime.types new file mode 100644 index 0000000000..b68cff21a6 --- /dev/null +++ b/lib/inets/test/httpd_SUITE_data/server_root/config/mime.types @@ -0,0 +1,4 @@ +text/html html +text/html htm +text/html shtml +image/gif gif diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index e9ecb2632a..ecb84e447c 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.7 +INETS_VSN = 5.10.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java index 5b9d13ad81..74afbbcca6 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java @@ -153,9 +153,6 @@ public class OtpSelf extends OtpLocalNode { * the port number you wish to use for incoming connections. * Specifying 0 lets the system choose an available port. * - * @param transportFactory - * the transport factory to use when creating connections. - * * @exception IOException * in case of server transport failure */ diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index a8cbdf9667..d73d1ff281 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -564,7 +564,8 @@ load_native_code_for_all_loaded() -> catch _:_ -> ok - end. + end, + ok. load_all_native(Loaded, ChunkTag) -> catch load_all_native_1(Loaded, ChunkTag). diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index daed6dd488..77cd5433de 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -25,7 +25,7 @@ %%%-------------------------------------------------------------------- %%% This is a rewrite of pre_heart from BS.3. %%% -%%% The purpose of this process-module is to act as an supervisor +%%% The purpose of this process-module is to act as a supervisor %%% of the entire erlang-system. This 'heart' beats with a frequence %%% satisfying an external port program *not* reboot the entire %%% system. If however the erlang-emulator would hang, a reboot is diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 2d124d95b7..49d4a8fe54 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -194,6 +194,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> CodeSize, CodeBinary, Refs, 0,[] % ColdSize, CRrefs ] = binary_to_term(Bin), + MD5 = erlang:md5(Bin), % use md5 of actual running code for module_info ?debug_msg("***** ErLLVM *****~nVersion: ~s~nCheckSum: ~w~nConstAlign: ~w~n" ++ "ConstSize: ~w~nConstMap: ~w~nLabelMap: ~w~nExportMap ~w~nRefs ~w~n", [Version, CheckSum, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, @@ -254,7 +255,8 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> AddressesOfClosuresToPatch = calculate_addresses(ClosurePatches, CodeAddress, Addresses), export_funs(Addresses), - export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch) + export_funs(Mod, MD5, BeamBinary, + Addresses, AddressesOfClosuresToPatch) end, %% Redirect references to the old module to the new module's BEAM stub. patch_to_emu_step2(OldReferencesToPatch), @@ -430,9 +432,9 @@ export_funs([FunDef | Addresses]) -> export_funs([]) -> ok. -export_funs(Mod, Beam, Addresses, ClosuresToPatch) -> +export_funs(Mod, MD5, Beam, Addresses, ClosuresToPatch) -> Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses], - Mod = code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch}), + Mod = code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch,MD5}), ok. %%======================================================================== diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index 835dcf2705..fb60a14afb 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -112,7 +112,6 @@ listen_options(Opts0) -> end, case application:get_env(kernel, inet_dist_listen_options) of {ok,ListenOpts} -> - erlang:display({inet_dist_listen_options, ListenOpts}), ListenOpts ++ Opts1; _ -> Opts1 @@ -340,7 +339,6 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> connect_options(Opts) -> case application:get_env(kernel, inet_dist_connect_options) of {ok,ConnectOpts} -> - erlang:display({inet_dist_listen_options, ConnectOpts}), ConnectOpts ++ Opts; _ -> Opts diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl index 05bf5aae18..1c2e56f083 100644 --- a/lib/kernel/test/error_logger_SUITE.erl +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -32,7 +32,7 @@ error_report/1, info_report/1, error/1, info/1, emulator/1, tty/1, logfile/1, add/1, delete/1]). --export([generate_error/0]). +-export([generate_error/2]). -export([init/1, handle_event/2, handle_call/2, handle_info/2, @@ -210,13 +210,16 @@ emulator(suite) -> []; emulator(doc) -> []; emulator(Config) when is_list(Config) -> ?line error_logger:add_report_handler(?MODULE, self()), - spawn(?MODULE, generate_error, []), - reported(emulator), + Msg = "Error in process ~p on node ~p with exit value:~n~p~n", + Error = {badmatch,4}, + Stack = [{module, function, 2, []}], + Pid = spawn(?MODULE, generate_error, [Error, Stack]), + reported(error, Msg, [Pid, node(), {Error, Stack}]), ?line my_yes = error_logger:delete_report_handler(?MODULE), ok. -generate_error() -> - erlang:error({badmatch,4}). +generate_error(Error, Stack) -> + erlang:raise(error, Error, Stack). %%----------------------------------------------------------------- %% We don't enables or disables tty error logging here. We do not @@ -283,15 +286,6 @@ reported(Tag, Type, Report) -> test_server:fail(no_report_received) end. -reported(emulator) -> - receive - {error, "~s~n", String} when is_list(String) -> - test_server:messages_get(), - ok - after 1000 -> - test_server:fail(no_report_received) - end. - %%----------------------------------------------------------------- %% The error_logger handler (gen_event behaviour). %% Sends a notification to the Tester process about the events diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index f501a4485b..b9c2fd915c 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -306,6 +306,8 @@ ms() -> -spec abort(_) -> no_return(). +abort(Reason = {aborted, _}) -> + exit(Reason); abort(Reason) -> exit({aborted, Reason}). @@ -1626,13 +1628,7 @@ dirty_read(Oid) -> dirty_read(Tab, Key) when is_atom(Tab), Tab /= schema -> -%% case catch ?ets_lookup(Tab, Key) of -%% {'EXIT', _} -> - %% Bad luck, we have to perform a real lookup - dirty_rpc(Tab, mnesia_lib, db_get, [Tab, Key]); -%% Val -> -%% Val -%% end; + dirty_rpc(Tab, mnesia_lib, db_get, [Tab, Key]); dirty_read(Tab, _Key) -> abort({bad_type, Tab}). diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 7bd207f816..fc7362a31d 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -411,7 +411,7 @@ pr_other(Var) -> verbose("~p (~p) val(mnesia_gvar, ~w) -> ~p ~n", [self(), process_info(self(), registered_name), Var, Why]), - exit(Why). + mnesia:abort(Why). %% Some functions for list valued variables add(Var, Val) -> diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index 2d1623b6ca..430c1f1d84 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -1338,11 +1338,11 @@ user_properties(Config) when is_list(Config) -> ?match([], mnesia:table_info(Tab2, user_properties)), ?match([], mnesia:table_info(Tab3, user_properties)), - ?match({'EXIT', {no_exists, {Tab1, user_property, PropKey}}}, + ?match({'EXIT', {aborted, {no_exists, {Tab1, user_property, PropKey}}}}, mnesia:read_table_property(Tab1, PropKey)), - ?match({'EXIT', {no_exists, {Tab2, user_property, PropKey}}}, + ?match({'EXIT', {aborted, {no_exists, {Tab2, user_property, PropKey}}}}, mnesia:read_table_property(Tab2, PropKey)), - ?match({'EXIT', {no_exists, {Tab3, user_property, PropKey}}}, + ?match({'EXIT', {aborted, {no_exists, {Tab3, user_property, PropKey}}}}, mnesia:read_table_property(Tab3, PropKey)), ?match({atomic, ok}, mnesia:write_table_property(Tab1, Prop)), diff --git a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl index 84db0b89f8..654a8f4385 100644 --- a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl +++ b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -533,7 +533,9 @@ unbind(_OE_THIS, _OE_State, []) -> %% Returns : %%---------------------------------------------------------------------- new_context(_OE_THIS, OE_State) -> - DBKey = term_to_binary({now(), node()}), + DBKey = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), %% Create a record in the table and set the key to a newly {reply, 'CosNaming_NamingContextExt':oe_create(DBKey, @@ -547,7 +549,9 @@ new_context(_OE_THIS, OE_State) -> %% Returns : %%---------------------------------------------------------------------- bind_new_context(OE_THIS, OE_State, N) -> - DBKey = term_to_binary({now(), node()}), + DBKey = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), %% Create a record in the table and set the key to a newly %% generated objectkey. %%?PRINTDEBUG("bind_new_context"), diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl index 9aec64892e..00dcf01c56 100644 --- a/lib/orber/src/cdr_decode.erl +++ b/lib/orber/src/cdr_decode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1110,10 +1110,8 @@ ifrid_to_name(Id, Type) -> [?LINE, Id, Type], ?DEBUG_LEVEL), corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}); Nodes -> - {A,B,C} = now(), - random:seed(A,B,C), L = length(Nodes), - IFR = get_ifr_node(Nodes, random:uniform(L), L), + IFR = get_ifr_node(Nodes, rand:uniform(L), L), list_to_atom('OrberApp_IFR':get_absolute_name(IFR, Id)) end; {'EXIT', Other} -> @@ -1176,7 +1174,7 @@ get_ifr_node(Nodes, N, L) -> _ -> %% Not able to commincate with the node. Try next one. NewL = L-1, - get_ifr_node(lists:delete(Node, Nodes), random:uniform(NewL), NewL) + get_ifr_node(lists:delete(Node, Nodes), rand:uniform(NewL), NewL) end. @@ -1260,10 +1258,8 @@ get_user_exception_type(TypeId) -> completion_status=?COMPLETED_MAYBE}) end; Nodes -> - {A,B,C} = now(), - random:seed(A,B,C), L = length(Nodes), - IFR = get_ifr_node(Nodes, random:uniform(L), L), + IFR = get_ifr_node(Nodes, rand:uniform(L), L), 'OrberApp_IFR':get_user_exception_type(IFR, TypeId) end end. diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index 586a02d540..f0eeb18c24 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1922,7 +1922,9 @@ mk_passive_objkey(Mod, Module, Flags) -> {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) -> "INIT"; diff --git a/lib/orber/src/orber.app.src b/lib/orber/src/orber.app.src index 8d2431338f..217c1b247f 100644 --- a/lib/orber/src/orber.app.src +++ b/lib/orber/src/orber.app.src @@ -105,7 +105,7 @@ {env, []}, {mod, {orber, []}}, {runtime_dependencies, ["stdlib-2.5","ssl-5.3.4","mnesia-4.12","kernel-3.0", - "inets-5.10","erts-6.0"]} + "inets-5.10","erts-7.0"]} ]}. diff --git a/lib/orber/src/orber_ifr_utils.erl b/lib/orber/src/orber_ifr_utils.erl index 11e3d1cd3b..35c891ef6e 100644 --- a/lib/orber/src/orber_ifr_utils.erl +++ b/lib/orber/src/orber_ifr_utils.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -289,10 +289,9 @@ makeref(Obj) -> %%% unique tag. I do this because the tuple generated takes a lot of space %%% when I dump the database. A binary is simply printed as #Bin, which %%% is much less obtrusive. -%%% The code has been moved to a macro defined in orber_ifr.hrl, so we -%%% can use a simpler uniqification code when debugging. -unique() -> term_to_binary({node(), now()}). +unique() -> term_to_binary({node(), {erlang:system_time(), + erlang:unique_integer()}}). %%%---------------------------------------------------------------------- %%% Check for an existing object with the Id of the object which is diff --git a/lib/orber/src/orber_objectkeys.erl b/lib/orber/src/orber_objectkeys.erl index b0e759187b..f57b1d811f 100644 --- a/lib/orber/src/orber_objectkeys.erl +++ b/lib/orber/src/orber_objectkeys.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -374,11 +374,11 @@ handle_call({register, Objkey, Pid, Type}, _From, State) -> %% No key exists. Ok to register. mnesia:write(#orber_objkeys{object_key=Objkey, pid=Pid, persistent=Type, - timestamp=now()}); + timestamp=erlang:monotonic_time(seconds)}); [X] when X#orber_objkeys.persistent==true, X#orber_objkeys.pid == dead -> %% A persistent object is being restarted. Update Pid & time. - mnesia:write(X#orber_objkeys{pid=Pid, timestamp=now()}); + mnesia:write(X#orber_objkeys{pid=Pid, timestamp=erlang:monotonic_time(seconds)}); [X] when is_pid(X#orber_objkeys.pid) -> %% Object exists, i.e., trying to create an object with %% the same name. @@ -477,7 +477,7 @@ handle_info({'EXIT', Pid, Reason}, State) when is_pid(Pid) -> Reason /= normal andalso Reason /= shutdown -> mnesia:write(X#orber_objkeys{pid=dead, - timestamp=now()}); + timestamp=erlang:monotonic_time(seconds)}); [X] when X#orber_objkeys.persistent==true -> mnesia:delete({orber_objkeys, X#orber_objkeys.object_key}); _-> @@ -503,8 +503,8 @@ code_change(_OldVsn, State, _Extra) -> %% Internal Functions %%----------------------------------------------------------------- -timetest(S, {MeSec, Sec, USec}) -> - {MeSec, Sec+S, USec} < now(). +timetest(S, TimeStamp) -> + TimeStamp+S < erlang:monotonic_time(seconds). get_key_from_pid(Pid) -> case mnesia:dirty_match_object({orber_objkeys, '_', Pid,'_','_'}) of diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl index 4507d90cce..4567728693 100644 --- a/lib/orber/src/orber_socket.erl +++ b/lib/orber/src/orber_socket.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -167,8 +167,6 @@ multi_connect([CurrentPort|Rest], Retries, ssl, Host, Port, Options, Timeout) -> get_port_sequence(Min, Max) -> case orber_env:iiop_out_ports_random() of true -> - {A1,A2,A3} = now(), - random:seed(A1, A2, A3), Seq = lists:seq(Min, Max), random_sequence((Max - Min) + 1, Seq, []); _ -> @@ -178,7 +176,7 @@ get_port_sequence(Min, Max) -> random_sequence(0, _, Acc) -> Acc; random_sequence(Length, Seq, Acc) -> - Nth = random:uniform(Length), + Nth = rand:uniform(Length), Value = lists:nth(Nth, Seq), NewSeq = lists:delete(Value, Seq), random_sequence(Length-1, NewSeq, [Value|Acc]). diff --git a/lib/orber/src/orber_web_server.erl b/lib/orber/src/orber_web_server.erl index 9d2a063a69..1cda862f1b 100644 --- a/lib/orber/src/orber_web_server.erl +++ b/lib/orber/src/orber_web_server.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,7 +46,7 @@ -define(DEBUG_LEVEL, 5). --record(state, {ts}). +-record(state, {}). -include("ifr_objects.hrl"). %%---------------------------------------------------------------------- @@ -133,9 +133,7 @@ delete_obj(Env, Input) -> %% Description: %%---------------------------------------------------------------------- init(_Arg)-> - {M, S, U} = now(), - TS = M*1000000000000 + S*1000000 + U, - {ok, #state{ts = TS}}. + {ok, #state{}}. terminate(_,_State)-> ok. diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl index 54ad92cf7e..d8e57f74e5 100644 --- a/lib/orber/test/cdrcoding_10_SUITE.erl +++ b/lib/orber/test/cdrcoding_10_SUITE.erl @@ -622,4 +622,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl index 29b3e33069..bcd2b70446 100644 --- a/lib/orber/test/cdrcoding_11_SUITE.erl +++ b/lib/orber/test/cdrcoding_11_SUITE.erl @@ -621,4 +621,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl index dd9b98434d..a58688b654 100644 --- a/lib/orber/test/cdrcoding_12_SUITE.erl +++ b/lib/orber/test/cdrcoding_12_SUITE.erl @@ -609,4 +609,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl index 58dd1b5dba..be3daf6198 100644 --- a/lib/orber/test/iop_ior_10_SUITE.erl +++ b/lib/orber/test/iop_ior_10_SUITE.erl @@ -182,4 +182,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl index 24b2f66357..4c4dd4effa 100644 --- a/lib/orber/test/iop_ior_11_SUITE.erl +++ b/lib/orber/test/iop_ior_11_SUITE.erl @@ -201,4 +201,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl index 4c6e9ddb91..9f50784666 100644 --- a/lib/orber/test/iop_ior_12_SUITE.erl +++ b/lib/orber/test/iop_ior_12_SUITE.erl @@ -202,4 +202,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 40d8846e0f..3d0132c3e6 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -922,9 +922,9 @@ max_requests(Node, Host, Port) -> spawn(orber_test_server, pseudo_call_delay, [Obj, 15000]), %% Wait for a second to be sure that the previous request has been sent timer:sleep(1000), - {MegaSecsB, Before, _} = now(), + {MegaSecsB, Before, _} = erlang:timestamp(), pseudo_calls(5, Obj), - {MegaSecsA, After, _} = now(), + {MegaSecsA, After, _} = erlang:timestamp(), %% Normally we we can perform hundreds of pseudo-calls per second. Hence, %% if we add 8 seconds to 'Before' it should still be less since we only %% allow one request at a time to the target ORB. diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl index ab2c2c872c..05146afded 100644 --- a/lib/orber/test/orber_acl_SUITE.erl +++ b/lib/orber/test/orber_acl_SUITE.erl @@ -272,21 +272,21 @@ ipv6_bm(_) -> bm2(Filters, Family, Ip) -> {ok, IPTuple} = inet:getaddr(Ip, Family), orber_acl:init_acl(Filters, Family), - TimeBefore1 = erlang:now(), + TimeBefore1 = erlang:timestamp(), bm_loop(IPTuple, ?NO_OF_TIMES), - TimeAfter1 = erlang:now(), + TimeAfter1 = erlang:timestamp(), orber_acl:clear_acl(), Time1 = computeTime(TimeBefore1, TimeAfter1), orber_acl:init_acl(Filters, Family), - TimeBefore2 = erlang:now(), + TimeBefore2 = erlang:timestamp(), bm_loop2(Ip, ?NO_OF_TIMES, Family), - TimeAfter2 = erlang:now(), + TimeAfter2 = erlang:timestamp(), orber_acl:clear_acl(), Time2 = computeTime(TimeBefore2, TimeAfter2), orber_acl:init_acl(Filters, Family), - TimeBefore3 = erlang:now(), + TimeBefore3 = erlang:timestamp(), bm_loop2(IPTuple, ?NO_OF_TIMES, Family), - TimeAfter3 = erlang:now(), + TimeAfter3 = erlang:timestamp(), orber_acl:clear_acl(), Time3 = computeTime(TimeBefore3, TimeAfter3), {ok, round(?NO_OF_TIMES/Time1), round(?NO_OF_TIMES/Time2), round(?NO_OF_TIMES/Time3)}. diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 46ed26f210..c970600fce 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -220,7 +220,7 @@ js_node(InitOptions) when is_list(InitOptions) -> js_node(InitOptions, []). js_node(InitOptions, StartOptions) when is_list(InitOptions) -> - {A,B,C} = erlang:now(), + {A,B,C} = erlang:timestamp(), [_, Host] = string:tokens(atom_to_list(node()), [$@]), _NewInitOptions = check_options(InitOptions), js_node_helper(Host, 0, lists:concat([A,'_',B,'_',C]), diff --git a/lib/orber/test/orber_test_server_impl.erl b/lib/orber/test/orber_test_server_impl.erl index 10a9caf242..9aa12e98fb 100644 --- a/lib/orber/test/orber_test_server_impl.erl +++ b/lib/orber/test/orber_test_server_impl.erl @@ -243,22 +243,22 @@ relay_cast(_Self, State, Target) -> %% Testing pseudo calls. pseudo_call(_Self, State) -> - io:format("orber_test_server:pseudo_call( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call( ~p )~n", [erlang:timestamp()]), {reply, ok, State}. pseudo_cast(_Self, State) -> - io:format("orber_test_server:pseudo_cast( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast( ~p )~n", [erlang:timestamp()]), {noreply, State}. pseudo_call_delay(_Self, State, Time) -> - io:format("orber_test_server:pseudo_call_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]), timer:sleep(Time), - io:format("orber_test_server:pseudo_call_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]), {reply, {ok, Time}, State}. pseudo_cast_delay(_Self, State, Time) -> - io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]), timer:sleep(Time), - io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]), {noreply, State}. pseudo_call_raise_exc(_Self, State, 1) -> diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 28fe9323fb..505c77de18 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1 +1 @@ -ORBER_VSN = 3.7.1 +ORBER_VSN = 3.8 diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index e9fd75a32c..20bb9ce391 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -31,13 +31,27 @@ #include <unistd.h> #include <string.h> +#if (defined(__APPLE__) && defined(__MACH__)) || defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) +#include <sys/param.h> +#include <sys/sysctl.h> +#include <limits.h> +#include <fcntl.h> +#endif +#if defined(__FreeBSD__) || defined(__DragonFly__) +#include <kvm.h> +#include <sys/user.h> +#endif + #if defined(__sun__) #include <kstat.h> #endif -#include <sys/sysinfo.h> #include <errno.h> +#if defined(__sun__) || defined(__linux__) +#include <sys/sysinfo.h> +#endif + #if defined(__linux__) #include <string.h> /* strlen */ @@ -124,10 +138,15 @@ static void util_measure(unsigned int **result_vec, int *result_sz); #if defined(__sun__) static unsigned int misc_measure(char* name); #endif -static void send(unsigned int data); +static void sendi(unsigned int data); static void sendv(unsigned int data[], int ints); static void error(char* err_msg); +#if (defined(__APPLE__) && defined(__MACH__)) || defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) +static void bsd_count_procs(void); +static void bsd_loadavg(int); +#endif + #if defined(__sun__) static kstat_ctl_t *kstat_ctl; #endif @@ -173,20 +192,104 @@ int main(int argc, char** argv) { error("Erlang has closed"); switch(cmd) { - case PING: send(4711); break; + case PING: sendi(4711); break; #if defined(__sun__) - case NPROCS: send(misc_measure("nproc")); break; - case AVG1: send(misc_measure("avenrun_1min")); break; - case AVG5: send(misc_measure("avenrun_5min")); break; - case AVG15: send(misc_measure("avenrun_15min")); break; + case NPROCS: sendi(misc_measure("nproc")); break; + case AVG1: sendi(misc_measure("avenrun_1min")); break; + case AVG5: sendi(misc_measure("avenrun_5min")); break; + case AVG15: sendi(misc_measure("avenrun_15min")); break; +#elif defined(__OpenBSD__) || (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__) || defined(__DragonFly__) + case NPROCS: bsd_count_procs(); break; + case AVG1: bsd_loadavg(0); break; + case AVG5: bsd_loadavg(1); break; + case AVG15: bsd_loadavg(2); break; #endif +#if defined(__sun__) || defined(__linux__) case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; +#endif case QUIT: free((void*)rv); return 0; default: error("Bad command"); break; } } return 0; /* supress warnings */ } + +/* ---------------------------- * + * BSD stat functions * + * ---------------------------- */ +#if defined(__OpenBSD__) || (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__) || defined(__DragonFly__) + +static void bsd_loadavg(int idx) { + double avgs[3]; + if (getloadavg(avgs, 3) < 0) { + error(strerror(errno)); + return; + } + sendi((unsigned int)(avgs[idx] * 256)); +} + +#endif + +#if defined(__OpenBSD__) + +static void bsd_count_procs(void) { + int err, nproc; + size_t len = sizeof(nproc); + int mib[] = { CTL_KERN, KERN_NPROCS }; + + err = sysctl(mib, sizeof(mib) / sizeof(mib[0]), &nproc, &len, NULL, 0); + if (err) { + error(strerror(errno)); + return; + } + + sendi((unsigned int)nproc); +} + +#elif defined(__FreeBSD__) || defined(__DragonFly__) + +static void bsd_count_procs(void) { + kvm_t *kd; + struct kinfo_proc *kp; + char err[_POSIX2_LINE_MAX]; + int cnt = 0; + + if ((kd = kvm_open(NULL, "/dev/null", NULL, O_RDONLY, err)) == NULL) { + error(err); + return; + } + +#if defined(KERN_PROC_PROC) + if ((kp = kvm_getprocs(kd, KERN_PROC_PROC, 0, &cnt)) == NULL) { +#else + if ((kp = kvm_getprocs(kd, KERN_PROC_ALL, 0, &cnt)) == NULL) { +#endif + error(strerror(errno)); + return; + } + + (void)kvm_close(kd); + sendi((unsigned int)cnt); +} + +#elif (defined(__APPLE__) && defined(__MACH__)) + +static void bsd_count_procs(void) { + int err; + size_t len = 0; + int mib[] = { CTL_KERN, KERN_PROC, KERN_PROC_ALL }; + + err = sysctl(mib, sizeof(mib) / sizeof(mib[0]), NULL, &len, NULL, 0); + if (err) { + error(strerror(errno)); + return; + } + + sendi((unsigned int)(len / sizeof(struct kinfo_proc))); +} + +#endif + /* ---------------------------- * * Linux stat functions * * ---------------------------- */ @@ -420,7 +523,7 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { * Generic functions * * ---------------------------- */ -static void send(unsigned int data) { sendv(&data, 1); } +static void sendi(unsigned int data) { sendv(&data, 1); } static void sendv(unsigned int data[], int ints) { static unsigned char *buf = NULL; @@ -474,7 +577,8 @@ static void error(char* err_msg) { buffer[i++] = '\n'; /* try to use one write only */ - if(write(FD_ERR, buffer, i)); + if(write(FD_ERR, buffer, i)) + ; exit(-1); } diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 66e7973e7e..0c26956c57 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -217,8 +217,6 @@ code_change(_OldVsn, State, _Extra) -> %% internal functions %%---------------------------------------------------------------------- -get_uint32_measurement(Request, #internal{port = P, os_type = {unix, sunos}}) -> - port_server_call(P, Request); get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) -> {ok,F} = file:open("/proc/loadavg",[read,raw]), {ok,D} = file:read_line(F), @@ -231,67 +229,13 @@ get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) -> ?ping -> 4711; ?nprocs -> PTotal end; -get_uint32_measurement(Request, #internal{os_type = {unix, freebsd}}) -> - D = os:cmd("/sbin/sysctl -n vm.loadavg") -- "\n", - {ok,[Load1,Load5,Load15],_} = io_lib:fread("{ ~f ~f ~f }", D), - %% We could count the lines from the ps command as well - case Request of - ?avg1 -> sunify(Load1); - ?avg5 -> sunify(Load5); - ?avg15 -> sunify(Load15); - ?ping -> 4711; - ?nprocs -> - Ps = os:cmd("/bin/ps -ax | /usr/bin/wc -l"), - {ok, [N], _} = io_lib:fread("~d", Ps), - N-1 - end; -get_uint32_measurement(Request, #internal{os_type = {unix, dragonfly}}) -> - D = os:cmd("/sbin/sysctl -n vm.loadavg") -- "\n", - {ok,[Load1,Load5,Load15],_} = io_lib:fread("{ ~f ~f ~f }", D), - %% We could count the lines from the ps command as well - case Request of - ?avg1 -> sunify(Load1); - ?avg5 -> sunify(Load5); - ?avg15 -> sunify(Load15); - ?ping -> 4711; - ?nprocs -> - Ps = os:cmd("/bin/ps -ax | /usr/bin/wc -l"), - {ok, [N], _} = io_lib:fread("~d", Ps), - N-1 - end; -get_uint32_measurement(Request, #internal{os_type = {unix, openbsd}}) -> - D = os:cmd("/sbin/sysctl -n vm.loadavg") -- "\n", - {ok, [L1, L5, L15], _} = io_lib:fread("~f ~f ~f", D), - case Request of - ?avg1 -> sunify(L1); - ?avg5 -> sunify(L5); - ?avg15 -> sunify(L15); - ?ping -> 4711; - ?nprocs -> - Ps = os:cmd("/bin/ps -ax | /usr/bin/wc -l"), - {ok, [N], _} = io_lib:fread("~d", Ps), - N-1 - end; -get_uint32_measurement(Request, #internal{os_type = {unix, darwin}}) -> - %% Get the load average using uptime, overriding Locale setting. - D = os:cmd("LANG=C LC_ALL=C uptime") -- "\n", - %% Here is a sample uptime string from Mac OS 10.3.8 (C Locale): - %% "11:17 up 12 days, 20:39, 2 users, load averages: 1.07 0.95 0.66" - %% The safest way to extract the load averages seems to be grab everything - %% after the last colon and then do an fread on that. - Avg = lists:reverse(hd(string:tokens(lists:reverse(D), ":"))), - {ok,[L1,L5,L15],_} = io_lib:fread("~f ~f ~f", Avg), - - case Request of - ?avg1 -> sunify(L1); - ?avg5 -> sunify(L5); - ?avg15 -> sunify(L15); - ?ping -> 4711; - ?nprocs -> - Ps = os:cmd("/bin/ps -ax | /usr/bin/wc -l"), - {ok, [N], _} = io_lib:fread("~d", Ps), - N-1 - end; +get_uint32_measurement(Request, #internal{port = P, os_type = {unix, Sys}}) when + Sys == sunos; + Sys == dragonfly; + Sys == openbsd; + Sys == freebsd; + Sys == darwin -> + port_server_call(P, Request); get_uint32_measurement(Request, #internal{os_type = {unix, Sys}}) when Sys == irix64; Sys == irix -> %% Get the load average using uptime. @@ -541,14 +485,16 @@ measurement_server_init() -> process_flag(trap_exit, true), OS = os:type(), Server = case OS of - {unix, Flavor} when Flavor==sunos; - Flavor==linux -> - {ok, Pid} = port_server_start_link(), - Pid; - {unix, Flavor} when Flavor==darwin; + {unix, Flavor} when + Flavor==sunos; + Flavor==linux; + Flavor==darwin; Flavor==freebsd; Flavor==dragonfly; - Flavor==openbsd; + Flavor==openbsd -> + {ok, Pid} = port_server_start_link(), + Pid; + {unix, Flavor} when Flavor==irix64; Flavor==irix -> not_used; diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index 17fb67e95c..d04819b5aa 100644 --- a/lib/public_key/doc/src/Makefile +++ b/lib/public_key/doc/src/Makefile @@ -42,8 +42,7 @@ XML_REF6_FILES = XML_PART_FILES = part.xml part_notes.xml XML_CHAPTER_FILES = \ introduction.xml \ - public_key_records.xml \ - cert_records.xml \ + public_key_records.xml \ using_public_key.xml \ notes.xml diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/cert_records.xml deleted file mode 100644 index 857a39bf40..0000000000 --- a/lib/public_key/doc/src/cert_records.xml +++ /dev/null @@ -1,690 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2008</year> - <year>2014</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Certificate records</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date>2008-02-06</date> - <rev>A</rev> - <file>cert_records.xml</file> - </header> - - <p>This chapter briefly describes erlang records derived from ASN1 - specifications used to handle <c> X509 certificates</c> and <c>CertificationRequest</c>. - The intent is to describe the data types -and not to specify the semantics of each component. For information on the -semantics, please see <url - href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280</url> and - <url href="http://www.ietf.org/rfc/rfc5967.txt">PKCS-10</url>. - </p> - - <p>Use the following include directive to get access to the - records and constant macros (OIDs) described in the following sections.</p> - - <code> -include_lib("public_key/include/public_key.hrl"). </code> - - <p>The used ASN1 specifications are available <c>asn1</c> subdirectory - of the application <c>public_key</c>. - </p> - - <section> - <title>Common Data Types</title> - - <p>Common non standard erlang - data types used to described the record fields in the - below sections are defined in <seealso - marker="public_key">public key reference manual </seealso> or - follows here.</p> - - <p><c>time() = uct_time() | general_time()</c></p> - - <p><c>uct_time() = {utcTime, "YYMMDDHHMMSSZ"} </c></p> - - <p><c>general_time() = {generalTime, "YYYYMMDDHHMMSSZ"} </c></p> - - <p><c> - general_name() = {rfc822Name, string()} | {dNSName, string()} - | {x400Address, string()} | {directoryName, - {rdnSequence, [#AttributeTypeAndValue'{}]}} | - | {eidPartyName, special_string()} - | {eidPartyName, special_string(), special_string()} - | {uniformResourceIdentifier, string()} | {ipAddress, string()} | - {registeredId, oid()} | {otherName, term()} - </c></p> - - <p><c> - special_string() = - {teletexString, string()} | {printableString, string()} | - {universalString, string()} | {utf8String, binary()} | - {bmpString, string()} - </c></p> - - <p><c> - dist_reason() = unused | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | privilegeWithdrawn | - aACompromise - </c></p> - </section> - - <section> - <title> PKIX Certificates</title> -<code> -#'Certificate'{ - tbsCertificate, % #'TBSCertificate'{} - signatureAlgorithm, % #'AlgorithmIdentifier'{} - signature % bitstring() - }. - -#'TBSCertificate'{ - version, % v1 | v2 | v3 - serialNumber, % integer() - signature, % #'AlgorithmIdentifier'{} - issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} - validity, % #'Validity'{} - subject, % {rdnSequence, [#AttributeTypeAndValue'{}]} - subjectPublicKeyInfo, % #'SubjectPublicKeyInfo'{} - issuerUniqueID, % binary() | asn1_novalue - subjectUniqueID, % binary() | asn1_novalue - extensions % [#'Extension'{}] - }. - -#'AlgorithmIdentifier'{ - algorithm, % oid() - parameters % der_encoded() - }. -</code> - -<code> -#'OTPCertificate'{ - tbsCertificate, % #'OTPTBSCertificate'{} - signatureAlgorithm, % #'SignatureAlgorithm' - signature % bitstring() - }. - -#'OTPTBSCertificate'{ - version, % v1 | v2 | v3 - serialNumber, % integer() - signature, % #'SignatureAlgorithm' - issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} - validity, % #'Validity'{} - subject, % {rdnSequence, [#AttributeTypeAndValue'{}]} - subjectPublicKeyInfo, % #'OTPSubjectPublicKeyInfo'{} - issuerUniqueID, % binary() | asn1_novalue - subjectUniqueID, % binary() | asn1_novalue - extensions % [#'Extension'{}] - }. - -#'SignatureAlgorithm'{ - algorithm, % id_signature_algorithm() - parameters % asn1_novalue | #'Dss-Parms'{} - }. -</code> - -<p><c> id_signature_algorithm() = ?oid_name_as_erlang_atom</c> for available -oid names see table below. Ex: ?'id-dsa-with-sha1'</p> -<table> - <row> - <cell align="left" valign="middle">OID name</cell> - </row> - <row> - <cell align="left" valign="middle">id-dsa-with-sha1</cell> - </row> - <row> - <cell align="left" valign="middle">id-dsaWithSHA1 (ISO alt oid to above)</cell> - </row> - <row> - <cell align="left" valign="middle">md2WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">md5WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">sha1WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">sha-1WithRSAEncryption (ISO alt oid to above)</cell> - </row> - <row> - <cell align="left" valign="middle">sha224WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">sha256WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">sha512WithRSAEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">ecdsa-with-SHA1</cell> - </row> - <tcaption>Signature algorithm oids </tcaption> -</table> - -<code> -#'AttributeTypeAndValue'{ - type, % id_attributes() - value % term() - }. -</code> - -<p><c>id_attributes() </c></p> -<table> - <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-name</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-surname</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-givenName</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-initials </cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-generationQualifier</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-commonName</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-localityName</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-stateOrProvinceName</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-organizationName</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-title</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-dnQualifier</cell> - <cell align="left" valign="middle">{printableString, string()}</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-countryName</cell> - <cell align="left" valign="middle">{printableString, string()}</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-serialNumber</cell> - <cell align="left" valign="middle">{printableString, string()}</cell> - </row> - <row> - <cell align="left" valign="middle">id-at-pseudonym</cell> - <cell align="left" valign="middle">special_string()</cell> - </row> - <tcaption>Attribute oids </tcaption> -</table> - -<code> -#'Validity'{ - notBefore, % time() - notAfter % time() - }. - -#'SubjectPublicKeyInfo'{ - algorithm, % #AlgorithmIdentifier{} - subjectPublicKey % binary() - }. - -#'SubjectPublicKeyInfoAlgorithm'{ - algorithm, % id_public_key_algorithm() - parameters % public_key_params() - }. -</code> - -<p><c> id_public_key_algorithm() </c></p> -<table> - <row> - <cell align="left" valign="middle">OID name</cell> - </row> - <row> - <cell align="left" valign="middle">rsaEncryption</cell> - </row> - <row> - <cell align="left" valign="middle">id-dsa</cell> - </row> - <row> - <cell align="left" valign="middle">dhpublicnumber</cell> - </row> - <row> - <cell align="left" valign="middle">id-keyExchangeAlgorithm</cell> - </row> - <row> - <cell align="left" valign="middle">id-ecPublicKey</cell> - </row> - <tcaption>Public key algorithm oids </tcaption> -</table> - -<code> -#'Extension'{ - extnID, % id_extensions() | oid() - critical, % boolean() - extnValue % der_encoded() - }. -</code> - -<p><c>id_extensions()</c> - <seealso marker="#StdCertExt">Standard Certificate Extensions</seealso>, - <seealso marker="#PrivIntExt">Private Internet Extensions</seealso>, - <seealso marker="#CRLCertExt">CRL Extensions</seealso> and - <seealso marker="#CRLEntryExt">CRL Entry Extensions</seealso>. -</p> - -</section> - -<section> - <marker id="StdCertExt"></marker> - <title>Standard certificate extensions</title> - - <table> - <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-authorityKeyIdentifier</cell> - <cell align="left" valign="middle">#'AuthorityKeyIdentifier'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-subjectKeyIdentifier</cell> - <cell align="left" valign="middle">oid()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-keyUsage</cell> - <cell align="left" valign="middle"> [key_usage()]</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-privateKeyUsagePeriod</cell> - <cell align="left" valign="middle">#'PrivateKeyUsagePeriod'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-certificatePolicies</cell> - <cell align="left" valign="middle">#'PolicyInformation'{}</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-policyMappings</cell> - <cell align="left" valign="middle">#'PolicyMappings_SEQOF'{}</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-subjectAltName</cell> - <cell align="left" valign="middle">general_name()</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-issuerAltName</cell> - <cell align="left" valign="middle">general_name()</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-subjectDirectoryAttributes</cell> - <cell align="left" valign="middle"> [#'Attribute'{}]</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-basicConstraints</cell> - <cell align="left" valign="middle">#'BasicConstraints'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-nameConstraints</cell> - <cell align="left" valign="middle">#'NameConstraints'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-policyConstraints</cell> - <cell align="left" valign="middle">#'PolicyConstraints'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-extKeyUsage</cell> - <cell align="left" valign="middle">[id_key_purpose()]</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-cRLDistributionPoints</cell> - <cell align="left" valign="middle">[#'DistributionPoint'{}]</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-inhibitAnyPolicy</cell> - <cell align="left" valign="middle">integer()</cell> - </row> - - <row> - <cell align="left" valign="middle">id-ce-freshestCRL</cell> - <cell align="left" valign="middle">[#'DistributionPoint'{}]</cell> - </row> - - - <tcaption>Standard Certificate Extensions</tcaption> - </table> - - <p><c> - key_usage() = digitalSignature | nonRepudiation | keyEncipherment| - dataEncipherment | keyAgreement | keyCertSign | cRLSign | encipherOnly | - decipherOnly - </c></p> - - <p><c> id_key_purpose()</c></p> - -<table> - <row> - <cell align="left" valign="middle">OID name</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-serverAuth</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-clientAuth</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-codeSigning</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-emailProtection</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-timeStamping</cell> - </row> - <row> - <cell align="left" valign="middle">id-kp-OCSPSigning</cell> - </row> - <tcaption>Key purpose oids </tcaption> -</table> - - <code> -#'AuthorityKeyIdentifier'{ - keyIdentifier, % oid() - authorityCertIssuer, % general_name() - authorityCertSerialNumber % integer() - }. - -#'PrivateKeyUsagePeriod'{ - notBefore, % general_time() - notAfter % general_time() - }. - -#'PolicyInformation'{ - policyIdentifier, % oid() - policyQualifiers % [#PolicyQualifierInfo{}] - }. - -#'PolicyQualifierInfo'{ - policyQualifierId, % oid() - qualifier % string() | #'UserNotice'{} - }. - -#'UserNotice'{ - noticeRef, % #'NoticeReference'{} - explicitText % string() - }. - -#'NoticeReference'{ - organization, % string() - noticeNumbers % [integer()] - }. - -#'PolicyMappings_SEQOF'{ - issuerDomainPolicy, % oid() - subjectDomainPolicy % oid() - }. - -#'Attribute'{ - type, % oid() - values % [der_encoded()] - }). - -#'BasicConstraints'{ - cA, % boolean() - pathLenConstraint % integer() - }). - -#'NameConstraints'{ - permittedSubtrees, % [#'GeneralSubtree'{}] - excludedSubtrees % [#'GeneralSubtree'{}] - }). - -#'GeneralSubtree'{ - base, % general_name() - minimum, % integer() - maximum % integer() - }). - -#'PolicyConstraints'{ - requireExplicitPolicy, % integer() - inhibitPolicyMapping % integer() - }). - -#'DistributionPoint'{ - distributionPoint, % {fullName, [general_name()]} | {nameRelativeToCRLIssuer, - [#AttributeTypeAndValue{}]} - reasons, % [dist_reason()] - cRLIssuer % [general_name()] - }). -</code> - -</section> - - <section> - <marker id="PrivIntExt"></marker> - <title>Private Internet Extensions</title> - - <table> - <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> - </row> - <row> - <cell align="left" valign="middle">id-pe-authorityInfoAccess</cell> - <cell align="left" valign="middle">[#'AccessDescription'{}]</cell> - </row> - <row> - <cell align="left" valign="middle">id-pe-subjectInfoAccess</cell> - <cell align="left" valign="middle">[#'AccessDescription'{}]</cell> - </row> - <tcaption>Private Internet Extensions</tcaption> - </table> - -<code> -#'AccessDescription'{ - accessMethod, % oid() - accessLocation % general_name() - }). -</code> - - </section> - -<section> - <title> CRL and CRL Extensions Profile</title> - - <code> -#'CertificateList'{ - tbsCertList, % #'TBSCertList{} - signatureAlgorithm, % #'AlgorithmIdentifier'{} - signature % bitstring() - }). - -#'TBSCertList'{ - version, % v2 (if defined) - signature, % #AlgorithmIdentifier{} - issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} - thisUpdate, % time() - nextUpdate, % time() - revokedCertificates, % [#'TBSCertList_revokedCertificates_SEQOF'{}] - crlExtensions % [#'Extension'{}] - }). - -#'TBSCertList_revokedCertificates_SEQOF'{ - userCertificate, % integer() - revocationDate, % timer() - crlEntryExtensions % [#'Extension'{}] - }). - </code> - - <section> - <marker id="CRLCertExt"></marker> - <title>CRL Extensions </title> - - <table> - <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-authorityKeyIdentifier</cell> - <cell align="left" valign="middle">#'AuthorityKeyIdentifier{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-issuerAltName</cell> - <cell align="left" valign="middle">{rdnSequence, [#AttributeTypeAndValue'{}]}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-cRLNumber</cell> - <cell align="left" valign="middle">integer()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-deltaCRLIndicator</cell> - <cell align="left" valign="middle">integer()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-issuingDistributionPoint</cell> - <cell align="left" valign="middle">#'IssuingDistributionPoint'{}</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-freshestCRL</cell> - <cell align="left" valign="middle">[#'Distributionpoint'{}]</cell> - </row> - - <tcaption>CRL Extensions</tcaption> - </table> - - <code> -#'IssuingDistributionPoint'{ - distributionPoint, % {fullName, [general_name()]} | {nameRelativeToCRLIssuer, - [#AttributeTypeAndValue'{}]} - onlyContainsUserCerts, % boolean() - onlyContainsCACerts, % boolean() - onlySomeReasons, % [dist_reason()] - indirectCRL, % boolean() - onlyContainsAttributeCerts % boolean() - }). - </code> - </section> - - <section> - <marker id="CRLEntryExt"></marker> - <title> CRL Entry Extensions </title> - - <table> - <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-cRLReason</cell> - <cell align="left" valign="middle">crl_reason()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-holdInstructionCode</cell> - <cell align="left" valign="middle">oid()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-invalidityDate</cell> - <cell align="left" valign="middle">general_time()</cell> - </row> - <row> - <cell align="left" valign="middle">id-ce-certificateIssuer</cell> - <cell align="left" valign="middle">general_name()</cell> - </row> - <tcaption>CRL Entry Extensions</tcaption> - </table> - <p><c> - crl_reason() = unspecified | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | removeFromCRL | privilegeWithdrawn | - aACompromise - </c></p> - </section> - - <section> - <marker id="PKCS10"></marker> - <title>PKCS#10 Certification Request</title> - <code> -#'CertificationRequest'{ - certificationRequestInfo #'CertificationRequestInfo'{}, - signatureAlgorithm #'CertificationRequest_signatureAlgorithm'{}}. - signature bitstring() - } - -#'CertificationRequestInfo'{ - version atom(), - subject {rdnSequence, [#AttributeTypeAndValue'{}]} , - subjectPKInfo #'CertificationRequestInfo_subjectPKInfo'{}, - attributes [#'AttributePKCS-10' {}] - } - -#'CertificationRequestInfo_subjectPKInfo'{ - algorithm #'CertificationRequestInfo_subjectPKInfo_algorithm'{} - subjectPublicKey bitstring() - } - -#'CertificationRequestInfo_subjectPKInfo_algorithm'{ - algorithm = oid(), - parameters = der_encoded() -} - -#'CertificationRequest_signatureAlgorithm'{ - algorithm = oid(), - parameters = der_encoded() - } - -#'AttributePKCS-10'{ - type = oid(), - values = [der_encoded()] -} - </code> - </section> - -</section> -</chapter> diff --git a/lib/public_key/doc/src/introduction.xml b/lib/public_key/doc/src/introduction.xml index bf11a092d8..6542c8c509 100644 --- a/lib/public_key/doc/src/introduction.xml +++ b/lib/public_key/doc/src/introduction.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2013</year> + <year>2015</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -36,27 +36,28 @@ <section> <title>Purpose</title> - <p> public_key deals with public key related file formats, digital - signatures and <url href="http://www.ietf.org/rfc/rfc5280.txt"> + <p>The Public Key application deals with public-key related file + formats, digital signatures, and <url href="http://www.ietf.org/rfc/rfc5280.txt"> X-509 certificates</url>. It is a library application that - provides encode/decode, sign/verify, encrypt/decrypt and similar - functionality, it does not read or write files it expects or returns + provides encode/decode, sign/verify, encrypt/decrypt, and similar + functionality. It does not read or write files, it expects or returns file contents or partial file contents as binaries. </p> </section> <section> <title>Prerequisites</title> - <p>It is assumed that the reader has a basic understanding - of the concepts of using public keys and digital certificates.</p> + <p>It is assumed that the reader is familiar with the Erlang programming + language and has a basic understanding of the concepts of using public-keys + and digital certificates.</p> </section> <section> - <title>Performance tips</title> - <p>The public_key decode and encode functions will try to use the NIFs - which are in the ASN1 compilers runtime modules if they can be found. - So for the best performance you want to have the ASN1 application in the - path of your system. </p> + <title>Performance Tips</title> + <p>The Public Key decode- and encode-functions try to use the NIFs + in the ASN.1 compilers runtime modules, if they can be found. + Thus, to have the ASN1 application in the + path of your system gives the best performance.</p> </section> </chapter> diff --git a/lib/public_key/doc/src/part.xml b/lib/public_key/doc/src/part.xml index 73146c8e2a..465f311946 100644 --- a/lib/public_key/doc/src/part.xml +++ b/lib/public_key/doc/src/part.xml @@ -31,15 +31,14 @@ <file>part.xml</file> </header> <description> - <p> This application provides an API to public key infrastructure + <p>This application provides an API to public-key infrastructure from <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC - 5280</url> (X.509 certificates) and public key formats defined by + 5280</url> (X.509 certificates) and public-key formats defined by the <url href="http://en.wikipedia.org/wiki/PKCS"> - PKCS-standard</url></p> + PKCS</url> standard.</p> </description> <xi:include href="introduction.xml"/> <xi:include href="public_key_records.xml"/> - <xi:include href="cert_records.xml"/> <xi:include href="using_public_key.xml"/> </part> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index b86d0fe0ab..883c52393f 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -31,11 +31,11 @@ <rev></rev> </header> <module>public_key</module> - <modulesummary> API module for public key infrastructure.</modulesummary> + <modulesummary>API module for public-key infrastructure.</modulesummary> <description> - <p>This module provides functions to handle public key infrastructure. It can - encode/decode different file formats (PEM, openssh), sign and verify digital signatures and validate - certificate paths and certificate revocation lists. + <p>This module provides functions to handle public-key infrastructure. It can + encode/decode different file formats (PEM, OpenSSH), sign and verify digital signatures, + and validate certificate paths and certificate revocation lists. </p> </description> @@ -43,94 +43,156 @@ <title>public_key</title> <list type="bulleted"> - <item>public_key requires the crypto and asn1 applications, the latter since R16 (hopefully the runtime dependency on asn1 will + <item> Public Key requires the Crypto and ASN1 applications, + the latter as OTP R16 (hopefully the runtime dependency on ASN1 will be removed again in the future).</item> <item>Supports <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> - - Internet X.509 Public Key Infrastructure Certificate and Certificate Revocation List (CRL) Profile </item> - <item>Supports <url href="http://www.ietf.org/rfc/rfc3447.txt"> PKCS-1 </url> - RSA Cryptography Standard </item> - <item>Supports <url href="http://csrc.nist.gov/publications/fips/fips186-3/fips_186-3.pdf"> DSS</url>- Digital Signature Standard (DSA - Digital Signature Algorithm)</item> - <item>Supports <url href="http://www.emc.com/emc-plus/rsa-labs/standards-initiatives/pkcs-3-diffie-hellman-key-agreement-standar.htm"> PKCS-3 </url> - Diffie-Hellman Key Agreement Standard </item> - <item>Supports <url href="http://www.ietf.org/rfc/rfc2898.txt"> PKCS-5</url> - Password-Based Cryptography Standard </item> - <item>Supports <url href="http://www.ietf.org/rfc/rfc5208.txt"> PKCS-8</url> - Private-Key Information Syntax Standard</item> - <item>Supports <url href="http://www.ietf.org/rfc/rfc5967.txt"> PKCS-10</url> - Certification Request Syntax Standard</item> + Internet X.509 Public-Key Infrastructure Certificate and Certificate Revocation List + (CRL) Profile </item> + <item>Supports <url href="http://www.ietf.org/rfc/rfc3447.txt"> PKCS-1 </url> - + RSA Cryptography Standard </item> + <item>Supports <url href="http://csrc.nist.gov/publications/fips/fips186-3/fips_186-3.pdf"> DSS</url> - + Digital Signature Standard (DSA - Digital Signature Algorithm)</item> + <item>Supports + <url href="http://www.emc.com/emc-plus/rsa-labs/standards-initiatives/pkcs-3-diffie-hellman-key-agreement-standar.htm"> PKCS-3 </url> - + Diffie-Hellman Key Agreement Standard </item> + <item>Supports <url href="http://www.ietf.org/rfc/rfc2898.txt"> PKCS-5</url> - + Password-Based Cryptography Standard </item> + <item>Supports <url href="http://www.ietf.org/rfc/rfc5208.txt"> PKCS-8</url> - + Private-Key Information Syntax Standard</item> + <item>Supports <url href="http://www.ietf.org/rfc/rfc5967.txt"> PKCS-10</url> - + Certification Request Syntax Standard</item> </list> </section> <section> - <title>COMMON DATA TYPES </title> + <title>DATA TYPES</title> - <note><p>All records used in this manual + <note><p>All records used in this Reference Manual <!-- except #policy_tree_node{} --> are generated from ASN.1 specifications and are documented in the User's Guide. See <seealso - marker="public_key_records">Public key records</seealso> and <seealso - marker="cert_records">X.509 Certificate records</seealso>. + marker="public_key_records">Public-key Records</seealso>. </p></note> <p>Use the following include directive to get access to the - records and constant macros described here and in the User's Guide.</p> + records and constant macros described here and in the User's Guide:</p> <code> -include_lib("public_key/include/public_key.hrl").</code> - <p><em>Data Types </em></p> - - <p><code>oid() - Object Identifier, a tuple of integers as generated by the ASN1 compiler.</code></p> - - <p><code>boolean() = true | false</code></p> + <p>The following data types are used in the functions for <c>public_key</c>:</p> - <p><code>string() = [bytes()]</code></p> - - <p><code>der_encoded() = binary()</code></p> - - <p><code>pki_asn1_type() = 'Certificate' | 'RSAPrivateKey'| 'RSAPublicKey' | - 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | - 'SubjectPublicKeyInfo' | 'PrivateKeyInfo' | - 'CertificationRequest' | 'ECPrivateKey' | 'EcpkParameters'</code></p> - - <p><code>pem_entry () = {pki_asn1_type(), binary(), %% DER or encrypted DER - not_encrypted | cipher_info()}</code></p> + <taglist> + <tag><c>oid()</c></tag> + <item><p>Object identifier, a tuple of integers as generated by the <c>ASN.1</c> compiler.</p></item> - <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", - crypto:rand_bytes(8) | {#'PBEParameter{}, digest_type()} |#'PBES2-params'{}}</code></p> - - <p><code>public_key() = rsa_public_key() | dsa_public_key() | ec_public_key()</code></p> - <p><code>private_key() = rsa_private_key() | dsa_private_key() | ec_private_key()</code></p> - <p><code>rsa_public_key() = #'RSAPublicKey'{}</code></p> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> + + <tag><c>string() =</c></tag> + <item><p><c>[bytes()]</c></p></item> + + <tag><c>der_encoded() =</c></tag> + <item><p><c>binary()</c></p></item> + + <tag><c>pki_asn1_type() =</c></tag> + <item> + <p><c>'Certificate'</c></p> + <p><c>| 'RSAPrivateKey'</c></p> + <p><c>| 'RSAPublicKey'</c></p> + <p><c>| 'DSAPrivateKey'</c></p> + <p><c>| 'DSAPublicKey'</c></p> + <p><c>| 'DHParameter'</c></p> + <p><c>| 'SubjectPublicKeyInfo'</c></p> + <p><c>| 'PrivateKeyInfo'</c></p> + <p><c>| 'CertificationRequest'</c></p> + <p><c>| 'ECPrivateKey'</c></p> + <p><c>| 'EcpkParameters'</c></p> + </item> + + <tag><c>pem_entry () =</c></tag> + <item><p><c>{pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted</c></p> + <p><c>| cipher_info()}</c></p></item> + + <tag><c>cipher_info() = </c></tag> + <item><p><c>{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)</c></p> + <p><c>| {#'PBEParameter{}, digest_type()} | #'PBES2-params'{}}</c></p> + </item> + + <tag><c>public_key() =</c></tag> + <item><p><c>rsa_public_key() | dsa_public_key() | ec_public_key()</c></p></item> + + <tag><c>private_key() =</c></tag> + <item><p><c>rsa_private_key() | dsa_private_key() | ec_private_key()</c></p></item> - <p><code>rsa_private_key() = #'RSAPrivateKey'{}</code></p> + <tag><c>rsa_public_key() =</c></tag> + <item><p><c>#'RSAPublicKey'{}</c></p></item> - <p><code>dsa_public_key() = {integer(), #'Dss-Parms'{}}</code></p> + <tag><c>rsa_private_key() =</c></tag> + <item><p><c>#'RSAPrivateKey'{}</c></p></item> - <p><code>dsa_private_key() = #'DSAPrivateKey'{}</code></p> + <tag><c>dsa_public_key() =</c></tag> + <item><p><c>{integer(), #'Dss-Parms'{}}</c></p></item> - <p><code>ec_public_key() = {#'ECPoint'{}, #'EcpkParameters'{} | - {namedCurve, oid()}}</code></p> - - <p><code>ec_private_key() = #'ECPrivateKey'{}</code></p> + <tag><c>dsa_private_key() =</c></tag> + <item><p><c>#'DSAPrivateKey'{}</c></p></item> - <p><code>public_crypt_options() = [{rsa_pad, rsa_padding()}].</code></p> + <tag><c>ec_public_key()</c></tag> + <item><p>= <c>{#'ECPoint'{}, #'EcpkParameters'{} | {namedCurve, oid()}}</c></p></item> - <p><code>rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | - 'rsa_no_padding'</code></p> + <tag><c>ec_private_key() =</c></tag> + <item><p><c>#'ECPrivateKey'{}</c></p></item> - <p><code>digest_type() - Union of below digest types</code></p> - - <p><code>rsa_digest_type() = 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | - 'sha512'</code></p> + <tag><c>public_crypt_options() =</c></tag> + <item><p><c>[{rsa_pad, rsa_padding()}]</c></p></item> - <p><code>dss_digest_type() = 'sha'</code></p> + <tag><c>rsa_padding() =</c></tag> + <item> + <p><c>'rsa_pkcs1_padding'</c></p> + <p><c>| 'rsa_pkcs1_oaep_padding'</c></p> + <p><c>| 'rsa_no_padding'</c></p> + </item> - <p><code>ecdsa_digest_type() = 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'</code></p> + <tag><c>digest_type() = </c></tag> + <item><p>Union of <c>rsa_digest_type()</c>, <c>dss_digest_type()</c>, + and <c>ecdsa_digest_type()</c>.</p></item> - <p><code>crl_reason() = unspecified | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | privilegeWithdrawn | aACompromise</code></p> + <tag><c>rsa_digest_type() = </c></tag> + <item><p><c>'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item> - <p><code>issuer_name() = {rdnSequence,[#'AttributeTypeAndValue'{}]} </code> </p> + <tag><c>dss_digest_type() = </c></tag> + <item><p><c>'sha'</c></p></item> - <p><code>ssh_file() = openssh_public_key | rfc4716_public_key | known_hosts | - auth_keys</code></p> + <tag><c>ecdsa_digest_type() = </c></tag> + <item><p><c>'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item> + + <tag><c>crl_reason() = </c></tag> + <item> + <p><c>unspecified</c></p> + <p><c>| keyCompromise</c></p> + <p><c>| cACompromise</c></p> + <p><c>| affiliationChanged</c></p> + <p><c>| superseded</c></p> + <p><c>| cessationOfOperation</c></p> + <p><c>| certificateHold</c></p> + <p><c>| privilegeWithdrawn</c></p> + <p><c>| aACompromise</c></p> + </item> + + <tag><c>issuer_name() =</c></tag> + <item><p><c>{rdnSequence,[#'AttributeTypeAndValue'{}]}</c></p> + </item> + + <tag><c>ssh_file() =</c></tag> + <item> + <p><c>openssh_public_key</c></p> + <p><c>| rfc4716_public_key</c></p> + <p><c>| known_hosts</c></p> + <p><c>| auth_keys</c></p> + </item> + </taglist> + <!-- <p><code>policy_tree() = [Root, Children]</code></p> --> @@ -138,12 +200,12 @@ <!-- <p><code>Children = [] | policy_tree()</code></p> --> -<!-- <p> The policy_tree_node record has the following fields:</p> --> +<!-- <p>The <c>policy_tree_node</c> record has the following fields:</p> --> <!-- <taglist> --> <!-- <tag>valid_policy</tag> --> -<!-- <item> Is a single policy OID representing a --> +<!-- <item>A single policy OID representing a --> <!-- valid policy for the path of length x.</item> --> <!-- <tag>qualifier_set</tag> --> @@ -151,13 +213,13 @@ <!-- with the valid policy in certificate x.</item> --> <!-- <tag>critically_indicator</tag> --> -<!-- <item>The critically_indicator indicates whether the --> +<!-- <item>Indicates whether the --> <!-- certificate policy extension in certificate x was marked as --> -<!-- critical. </item> --> +<!-- critical.</item> --> <!-- <tag>expected_policy_set</tag> --> -<!-- <item>The expected_policy_set contains one or more policy OIDs --> -<!-- that would satisfy this policy in the certificate x+1. </item> --> +<!-- <item>Contains one or more policy OIDs --> +<!-- that would satisfy this policy in the certificate x+1.</item> --> <!-- </taglist> --> </section> @@ -166,27 +228,27 @@ <func> <name>compute_key(OthersKey, MyKey)-></name> <name>compute_key(OthersKey, MyKey, Params)-></name> - <fsummary> Compute shared secret</fsummary> + <fsummary>Computes shared secret.</fsummary> <type> <v>OthersKey = #'ECPoint'{} | binary(), MyKey = #'ECPrivateKey'{} | binary()</v> <v>Params = #'DHParameter'{}</v> </type> <desc> - <p> Compute shared secret </p> + <p>Computes shared secret.</p> </desc> </func> <func> <name>decrypt_private(CipherText, Key) -> binary()</name> <name>decrypt_private(CipherText, Key, Options) -> binary()</name> - <fsummary>Public key decryption.</fsummary> + <fsummary>Public-key decryption.</fsummary> <type> <v>CipherText = binary()</v> <v>Key = rsa_private_key()</v> <v>Options = public_crypt_options()</v> </type> <desc> - <p>Public key decryption using the private key. See also <seealso + <p>Public-key decryption using the private key. See also <seealso marker="crypto:crypto#private_decrypt/4">crypto:private_decrypt/4</seealso></p> </desc> </func> @@ -194,156 +256,156 @@ <func> <name>decrypt_public(CipherText, Key) - > binary()</name> <name>decrypt_public(CipherText, Key, Options) - > binary()</name> - <fsummary></fsummary> + <fsummary>Public-key decryption.</fsummary> <type> <v>CipherText = binary()</v> <v>Key = rsa_public_key()</v> <v>Options = public_crypt_options()</v> </type> <desc> - <p> Public key decryption using the public key. See also <seealso + <p>Public-key decryption using the public key. See also <seealso marker="crypto:crypto#public_decrypt/4">crypto:public_decrypt/4</seealso></p> </desc> </func> <func> <name>der_decode(Asn1type, Der) -> term()</name> - <fsummary> Decodes a public key ASN.1 DER encoded entity.</fsummary> + <fsummary>Decodes a public-key ASN.1 DER encoded entity.</fsummary> <type> <v>Asn1Type = atom()</v> - <d> ASN.1 type present in the public_key applications - asn1 specifications.</d> + <d>ASN.1 type present in the Public Key applications + ASN.1 specifications.</d> <v>Der = der_encoded()</v> </type> <desc> - <p> Decodes a public key ASN.1 DER encoded entity.</p> + <p>Decodes a public-key ASN.1 DER encoded entity.</p> </desc> </func> <func> <name>der_encode(Asn1Type, Entity) -> der_encoded()</name> - <fsummary> Encodes a public key entity with asn1 DER encoding.</fsummary> + <fsummary>Encodes a public-key entity with ASN.1 DER encoding.</fsummary> <type> <v>Asn1Type = atom()</v> - <d> Asn1 type present in the public_key applications + <d>ASN.1 type present in the Public Key applications ASN.1 specifications.</d> <v>Entity = term()</v> - <d>The erlang representation of <c>Asn1Type</c></d> + <d>Erlang representation of <c>Asn1Type</c></d> </type> <desc> - <p> Encodes a public key entity with ASN.1 DER encoding.</p> + <p>Encodes a public-key entity with ASN.1 DER encoding.</p> </desc> </func> + <func> + <name>encrypt_private(PlainText, Key) -> binary()</name> + <fsummary>Public-key encryption using the private key.</fsummary> + <type> + <v>PlainText = binary()</v> + <v>Key = rsa_private_key()</v> + </type> + <desc> + <p>Public-key encryption using the private key. + See also <seealso + marker="crypto:crypto#private_encrypt/4">crypto:private_encrypt/4</seealso>.</p> + </desc> + </func> + + <func> + <name>encrypt_public(PlainText, Key) -> binary()</name> + <fsummary>Public-key encryption using the public key.</fsummary> + <type> + <v>PlainText = binary()</v> + <v>Key = rsa_public_key()</v> + </type> + <desc> + <p>Public-key encryption using the public key. See also <seealso + marker="crypto:crypto#public_encrypt/4">crypto:public_encrypt/4</seealso>.</p> + </desc> + </func> + <func> <name>generate_key(Params) -> {Public::binary(), Private::binary()} | #'ECPrivateKey'{} </name> - <fsummary>Generates a new keypair</fsummary> + <fsummary>Generates a new keypair.</fsummary> <type> - <v> Params = #'DHParameter'{} | {namedCurve, oid()} | #'ECParameters'{} </v> + <v>Params = #'DHParameter'{} | {namedCurve, oid()} | #'ECParameters'{}</v> </type> <desc> - <p>Generates a new keypair</p> + <p>Generates a new keypair.</p> </desc> </func> <func> <name>pem_decode(PemBin) -> [pem_entry()]</name> - <fsummary>Decode PEM binary data and return - entries as ASN.1 DER encoded entities. </fsummary> + <fsummary>Decodes PEM binary data and returns + entries as ASN.1 DER encoded entities.</fsummary> <type> <v>PemBin = binary()</v> <d>Example {ok, PemBin} = file:read_file("cert.pem").</d> </type> <desc> - <p>Decode PEM binary data and return + <p>Decodes PEM binary data and returns entries as ASN.1 DER encoded entities.</p> </desc> </func> <func> <name>pem_encode(PemEntries) -> binary()</name> - <fsummary>Creates a PEM binary</fsummary> + <fsummary>Creates a PEM binary.</fsummary> <type> <v> PemEntries = [pem_entry()] </v> </type> <desc> - <p>Creates a PEM binary</p> + <p>Creates a PEM binary.</p> </desc> </func> <func> <name>pem_entry_decode(PemEntry) -> term()</name> <name>pem_entry_decode(PemEntry, Password) -> term()</name> - <fsummary>Decodes a pem entry.</fsummary> + <fsummary>Decodes a PEM entry.</fsummary> <type> - <v> PemEntry = pem_entry() </v> - <v> Password = string() </v> + <v>PemEntry = pem_entry()</v> + <v>Password = string()</v> </type> <desc> - <p>Decodes a PEM entry. pem_decode/1 returns a list of PEM - entries. Note that if the PEM entry is of type - 'SubjectPublickeyInfo' it will be further decoded to an - rsa_public_key() or dsa_public_key().</p> + <p>Decodes a PEM entry. <c>pem_decode/1</c> returns a list of PEM + entries. Notice that if the PEM entry is of type + 'SubjectPublickeyInfo', it is further decoded to an + <c>rsa_public_key()</c> or <c>dsa_public_key()</c>.</p> </desc> </func> <func> <name>pem_entry_encode(Asn1Type, Entity) -> pem_entry()</name> <name>pem_entry_encode(Asn1Type, Entity, {CipherInfo, Password}) -> pem_entry()</name> - <fsummary> Creates a PEM entry that can be fed to pem_encode/1.</fsummary> + <fsummary>Creates a PEM entry that can be fed to <c>pem_encode/1</c>.</fsummary> <type> <v>Asn1Type = pki_asn1_type()</v> <v>Entity = term()</v> - <d>The Erlang representation of - <c>Asn1Type</c>. If <c>Asn1Type</c> is 'SubjectPublicKeyInfo' - then <c>Entity</c> must be either an rsa_public_key() or a - dsa_public_key() and this function will create the appropriate + <d>Erlang representation of + <c>Asn1Type</c>. If <c>Asn1Type</c> is 'SubjectPublicKeyInfo', + <c>Entity</c> must be either an <c>rsa_public_key()</c> or a + <c>dsa_public_key()</c> and this function creates the appropriate 'SubjectPublicKeyInfo' entry. </d> <v>CipherInfo = cipher_info()</v> <v>Password = string()</v> </type> <desc> - <p> Creates a PEM entry that can be feed to pem_encode/1.</p> + <p>Creates a PEM entry that can be feed to <c>pem_encode/1</c>.</p> </desc> </func> - - <func> - <name>encrypt_private(PlainText, Key) -> binary()</name> - <fsummary> Public key encryption using the private key.</fsummary> - <type> - <v>PlainText = binary()</v> - <v>Key = rsa_private_key()</v> - </type> - <desc> - <p> Public key encryption using the private key. - See also <seealso - marker="crypto:crypto#private_encrypt/4">crypto:private_encrypt/4</seealso></p> - </desc> - </func> - - <func> - <name>encrypt_public(PlainText, Key) -> binary()</name> - <fsummary> Public key encryption using the public key.</fsummary> - <type> - <v>PlainText = binary()</v> - <v>Key = rsa_public_key()</v> - </type> - <desc> - <p> Public key encryption using the public key. See also <seealso - marker="crypto:crypto#public_encrypt/4">crypto:public_encrypt/4</seealso></p> - </desc> - </func> <func> <name>pkix_decode_cert(Cert, otp|plain) -> #'Certificate'{} | #'OTPCertificate'{}</name> - <fsummary> Decodes an ASN.1 DER encoded PKIX x509 certificate.</fsummary> + <fsummary>Decodes an ASN.1 DER-encoded PKIX x509 certificate.</fsummary> <type> <v>Cert = der_encoded()</v> </type> <desc> - <p>Decodes an ASN.1 DER encoded PKIX certificate. The otp option - will use the customized ASN.1 specification OTP-PKIX.asn1 for + <p>Decodes an ASN.1 DER-encoded PKIX certificate. Option <c>otp</c> + uses the customized ASN.1 specification OTP-PKIX.asn1 for decoding and also recursively decode most of the standard parts.</p> </desc> @@ -355,54 +417,54 @@ certificate.</fsummary> <type> <v>Asn1Type = atom()</v> - <d>The ASN.1 type can be 'Certificate', 'OTPCertificate' or a subtype of either .</d> + <d>The ASN.1 type can be 'Certificate', 'OTPCertificate' or a subtype of either.</d> <v>Entity = #'Certificate'{} | #'OTPCertificate'{} | a valid subtype</v> </type> <desc> <p>DER encodes a PKIX x509 certificate or part of such a certificate. This function must be used for encoding certificates or parts of certificates - that are decoded/created in the otp format, whereas for the plain format this - function will directly call der_encode/2. </p> + that are decoded/created in the <c>otp</c> format, whereas for the plain format this + function directly calls <c>der_encode/2</c>.</p> </desc> </func> <func> <name>pkix_is_issuer(Cert, IssuerCert) -> boolean()</name> - <fsummary> Checks if <c>IssuerCert</c> issued <c>Cert</c> </fsummary> + <fsummary>Checks if <c>IssuerCert</c> issued <c>Cert</c>.</fsummary> <type> <v>Cert = der_encoded() | #'OTPCertificate'{}</v> <v>IssuerCert = der_encoded() | #'OTPCertificate'{}</v> </type> <desc> - <p> Checks if <c>IssuerCert</c> issued <c>Cert</c> </p> + <p>Checks if <c>IssuerCert</c> issued <c>Cert</c>.</p> </desc> </func> <func> <name>pkix_is_fixed_dh_cert(Cert) -> boolean()</name> - <fsummary> Checks if a Certificate is a fixed Diffie-Hellman Cert.</fsummary> + <fsummary>Checks if a certificate is a fixed Diffie-Hellman certificate.</fsummary> <type> <v>Cert = der_encoded() | #'OTPCertificate'{}</v> </type> <desc> - <p> Checks if a Certificate is a fixed Diffie-Hellman Cert.</p> + <p>Checks if a certificate is a fixed Diffie-Hellman certificate.</p> </desc> </func> <func> <name>pkix_is_self_signed(Cert) -> boolean()</name> - <fsummary> Checks if a Certificate is self signed.</fsummary> + <fsummary>Checks if a certificate is self-signed.</fsummary> <type> <v>Cert = der_encoded() | #'OTPCertificate'{}</v> </type> <desc> - <p> Checks if a Certificate is self signed.</p> + <p>Checks if a certificate is self-signed.</p> </desc> </func> <func> <name>pkix_issuer_id(Cert, IssuedBy) -> {ok, IssuerID} | {error, Reason}</name> - <fsummary> Returns the issuer id.</fsummary> + <fsummary>Returns the issuer id.</fsummary> <type> <v>Cert = der_encoded() | #'OTPCertificate'{}</v> <v>IssuedBy = self | other</v> @@ -411,43 +473,43 @@ <v>Reason = term()</v> </type> <desc> - <p> Returns the issuer id.</p> + <p>Returns the issuer id.</p> </desc> </func> <func> <name>pkix_normalize_name(Issuer) -> Normalized</name> - <fsummary>Normalizes a issuer name so that it can be easily - compared to another issuer name. </fsummary> + <fsummary>Normalizes an issuer name so that it can be easily + compared to another issuer name.</fsummary> <type> <v>Issuer = issuer_name()</v> <v>Normalized = issuer_name()</v> </type> <desc> - <p>Normalizes a issuer name so that it can be easily + <p>Normalizes an issuer name so that it can be easily compared to another issuer name.</p> </desc> </func> <func> <name>pkix_path_validation(TrustedCert, CertChain, Options) -> {ok, {PublicKeyInfo, PolicyTree}} | {error, {bad_cert, Reason}} </name> - <fsummary> Performs a basic path validation according to RFC 5280.</fsummary> + <fsummary>Performs a basic path validation according to RFC 5280.</fsummary> <type> - <v> TrustedCert = #'OTPCertificate'{} | der_encoded() | atom() </v> - <d>Normally a trusted certificate but it can also be a path validation + <v>TrustedCert = #'OTPCertificate'{} | der_encode() | atom()</v> + <d>Normally a trusted certificate, but it can also be a path-validation error that can be discovered while - constructing the input to this function and that should be run through the <c>verify_fun</c>. - For example <c>unknown_ca </c> or <c>selfsigned_peer </c> + constructing the input to this function and that is to be run through the <c>verify_fun</c>. + Examples are <c>unknown_ca</c> and <c>selfsigned_peer.</c> </d> - <v> CertChain = [der_encoded()]</v> - <d>A list of DER encoded certificates in trust order ending with the peer certificate.</d> - <v> Options = proplists:proplist()</v> + <v>CertChain = [der_encode()]</v> + <d>A list of DER-encoded certificates in trust order ending with the peer certificate.</d> + <v>Options = proplists:proplist()</v> <v>PublicKeyInfo = {?'rsaEncryption' | ?'id-dsa', rsa_public_key() | integer(), 'NULL' | 'Dss-Parms'{}}</v> - <v> PolicyTree = term() </v> - <d>At the moment this will always be an empty list as Policies are not currently supported</d> - <v> Reason = cert_expired | invalid_issuer | invalid_signature | name_not_permitted | + <v>PolicyTree = term()</v> + <d>At the moment this is always an empty list as policies are not currently supported.</d> + <v>Reason = cert_expired | invalid_issuer | invalid_signature | name_not_permitted | missing_basic_constraint | invalid_key_usage | {revoked, crl_reason()} | atom() </v> </type> @@ -455,17 +517,17 @@ <p> Performs a basic path validation according to <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280.</url> - However CRL validation is done separately by <seealso - marker="#pkix_crls_validate-3">pkix_crls_validate/3 </seealso> and should be called - from the supplied <c>verify_fun</c> + However, CRL validation is done separately by <seealso + marker="#pkix_crls_validate-3">pkix_crls_validate/3 </seealso> and is to be called + from the supplied <c>verify_fun</c>. </p> - <taglist> - <p> Available options are: </p> + <p>Available options:</p> + <taglist> <tag>{verify_fun, fun()}</tag> <item> - <p>The fun should be defined as:</p> + <p>The fun must be defined as:</p> <code> fun(OtpCert :: #'OTPCertificate'{}, @@ -478,53 +540,53 @@ fun(OtpCert :: #'OTPCertificate'{}, {unknown, UserState :: term()}. </code> - <p>If the verify callback fun returns {fail, Reason}, the + <p>If the verify callback fun returns <c>{fail, Reason}</c>, the verification process is immediately stopped. If the verify - callback fun returns {valid, UserState}, the verification - process is continued, this can be used to accept specific path - validation errors such as <c>selfsigned_peer</c> as well as - verifying application specific extensions. If called with an - extension unknown to the user application the return value - {unknown, UserState} should be used.</p> + callback fun returns <c>{valid, UserState}</c>, the verification + process is continued. This can be used to accept specific path + validation errors, such as <c>selfsigned_peer</c>, as well as + verifying application-specific extensions. If called with an + extension unknown to the user application, the return value + <c>{unknown, UserState}</c> is to be used.</p> </item> <tag>{max_path_length, integer()}</tag> <item> The <c>max_path_length</c> is the maximum number of non-self-issued - intermediate certificates that may follow the peer certificate - in a valid certification path. So if <c>max_path_length</c> is 0 the PEER must - be signed by the trusted ROOT-CA directly, if 1 the path can - be PEER, CA, ROOT-CA, if it is 2 PEER, CA, CA, ROOT-CA and so - on. + intermediate certificates that can follow the peer certificate + in a valid certification path. So, if <c>max_path_length</c> is 0, the PEER must + be signed by the trusted ROOT-CA directly, if it is 1, the path can + be PEER, CA, ROOT-CA, if it is 2, the path can + be PEER, CA, CA, ROOT-CA, and so on. </item> </taglist> - <p> Possible reasons for a bad certificate are: </p> + <p>Possible reasons for a bad certificate: </p> <taglist> <tag>cert_expired</tag> - <item>The certificate is no longer valid as its expiration date has passed.</item> + <item><p>Certificate is no longer valid as its expiration date has passed.</p></item> <tag>invalid_issuer</tag> - <item>The certificate issuer name does not match the name of the issuer certificate in the chain.</item> + <item><p>Certificate issuer name does not match the name of the issuer certificate in the chain.</p></item> <tag>invalid_signature</tag> - <item>The certificate was not signed by its issuer certificate in the chain.</item> + <item><p>Certificate was not signed by its issuer certificate in the chain.</p></item> <tag>name_not_permitted</tag> - <item>Invalid Subject Alternative Name extension.</item> + <item><p>Invalid Subject Alternative Name extension.</p></item> <tag>missing_basic_constraint</tag> - <item>Certificate, required to have the basic constraints extension, does not have - a basic constraints extension.</item> + <item><p>Certificate, required to have the basic constraints extension, does not have + a basic constraints extension.</p></item> <tag>invalid_key_usage</tag> - <item>Certificate key is used in an invalid way according to the key usage extension.</item> + <item><p>Certificate key is used in an invalid way according to the key-usage extension.</p></item> <tag>{revoked, crl_reason()}</tag> - <item>Certificate has been revoked.</item> + <item><p>Certificate has been revoked.</p></item> <tag>atom()</tag> - <item>Application specific error reason that should be checked by the verify_fun</item> + <item><p>Application-specific error reason that is to be checked by the <c>verify_fun</c>.</p></item> </taglist> </desc> @@ -543,44 +605,47 @@ fun(OtpCert :: #'OTPCertificate'{}, <func> <name>pkix_crls_validate(OTPCertificate, DPAndCRLs, Options) -> CRLStatus()</name> - <fsummary> Performs CRL validation.</fsummary> + <fsummary>Performs CRL validation.</fsummary> <type> - <v> OTPCertificate = #'OTPCertificate'{}</v> - <v> DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v> - <v> Options = proplists:proplist()</v> - <v> CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | + <v>OTPCertificate = #'OTPCertificate'{}</v> + <v>DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v> + <v>Options = proplists:proplist()</v> + <v>CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}</v> </type> <desc> - <p> Performs CRL validation. It is intended to be called from + <p>Performs CRL validation. It is intended to be called from the verify fun of <seealso marker="#pkix_path_validation-3"> pkix_path_validation/3 - </seealso></p> + </seealso>.</p> + + <p>Available options:</p> + <taglist> - <p> Available options are: </p> + <tag>{update_crl, fun()}</tag> <item> - <p>The fun has the following type spec:</p> + <p>The fun has the following type specification:</p> <code> fun(#'DistributionPoint'{}, #'CertificateList'{}) -> #'CertificateList'{}</code> - <p>The fun should use the information in the distribution point to acesses - the lates possible version of the CRL. If this fun is not specified - public_key will use the default implementation: + <p>The fun uses the information in the distribution point to access + the latest possible version of the CRL. If this fun is not specified, + Public Key uses the default implementation: </p> <code> fun(_DP, CRL) -> CRL end</code> </item> <tag>{issuer_fun, fun()}</tag> <item> - <p>The fun has the following type spec:</p> + <p>The fun has the following type specification:</p> <code> fun(#'DistributionPoint'{}, #'CertificateList'{}, {rdnSequence,[#'AttributeTypeAndValue'{}]}, term()) -> {ok, #'OTPCertificate'{}, [der_encoded]}</code> - <p>The fun should return the root certificate and certificate chain + <p>The fun returns the root certificate and certificate chain that has signed the CRL. </p> <code> fun(DP, CRL, Issuer, UserState) -> {ok, RootCert, CertChain}</code> @@ -635,83 +700,83 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <v>Key = rsa_public_key() | dsa_public_key()</v> </type> <desc> - <p>Signs a 'OTPTBSCertificate'. Returns the corresponding - der encoded certificate.</p> + <p>Signs an 'OTPTBSCertificate'. Returns the corresponding + DER-encoded certificate.</p> </desc> </func> <func> <name>pkix_sign_types(AlgorithmId) -> {DigestType, SignatureType}</name> - <fsummary>Translates signature algorithm oid to erlang digest and signature algorithm types.</fsummary> + <fsummary>Translates signature algorithm OID to Erlang digest and signature algorithm types.</fsummary> <type> <v>AlgorithmId = oid()</v> - <d>Signature oid from a certificate or a certificate revocation list</d> - <v>DigestType = rsa_digest_type() | dss_digest_type() </v> + <d>Signature OID from a certificate or a certificate revocation list.</d> + <v>DigestType = rsa_digest_type() | dss_digest_type()</v> <v>SignatureType = rsa | dsa</v> </type> <desc> - <p>Translates signature algorithm oid to erlang digest and signature types. + <p>Translates signature algorithm OID to Erlang digest and signature types. </p> </desc> </func> <func> <name>pkix_verify(Cert, Key) -> boolean()</name> - <fsummary> Verify pkix x.509 certificate signature.</fsummary> + <fsummary>Verifies PKIX x.509 certificate signature.</fsummary> <type> <v>Cert = der_encoded()</v> <v>Key = rsa_public_key() | dsa_public_key()</v> </type> <desc> - <p> Verify PKIX x.509 certificate signature.</p> + <p>Verifies PKIX x.509 certificate signature.</p> </desc> </func> <func> <name>sign(Msg, DigestType, Key) -> binary()</name> - <fsummary> Create digital signature.</fsummary> + <fsummary>Creates a digital signature.</fsummary> <type> <v>Msg = binary() | {digest,binary()}</v> - <d>The msg is either the binary "plain text" data to be - signed or it is the hashed value of "plain text" i.e. the + <d>The <c>Msg</c> is either the binary "plain text" data to be + signed or it is the hashed value of "plain text", that is, the digest.</d> <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> <v>Key = rsa_private_key() | dsa_private_key() | ec_private_key()</v> </type> <desc> - <p> Creates a digital signature.</p> + <p>Creates a digital signature.</p> </desc> </func> <func> <name>ssh_decode(SshBin, Type) -> [{public_key(), Attributes::list()}]</name> - <fsummary>Decodes a ssh file-binary. </fsummary> + <fsummary>Decodes an SSH file-binary.</fsummary> <type> <v>SshBin = binary()</v> <d>Example {ok, SshBin} = file:read_file("known_hosts").</d> - <v> Type = public_key | ssh_file()</v> - <d>If <c>Type</c> is <c>public_key</c> the binary may be either - a rfc4716 public key or a openssh public key.</d> + <v>Type = public_key | ssh_file()</v> + <d>If <c>Type</c> is <c>public_key</c> the binary can be either + an RFC4716 public key or an OpenSSH public key.</d> </type> <desc> - <p> Decodes a ssh file-binary. In the case of know_hosts or - auth_keys the binary may include one or more lines of the + <p>Decodes an SSH file-binary. In the case of <c>know_hosts</c> or + <c>auth_keys</c>, the binary can include one or more lines of the file. Returns a list of public keys and their attributes, possible attribute values depends on the file type represented by the binary. </p> <taglist> - <tag>rfc4716 attributes - see RFC 4716</tag> - <item>{headers, [{string(), utf8_string()}]}</item> - <tag>auth_key attributes - see man sshd </tag> + <tag>RFC4716 attributes - see RFC 4716.</tag> + <item><p>{headers, [{string(), utf8_string()}]}</p></item> + <tag>auth_key attributes - see manual page for sshd.</tag> <item>{comment, string()}</item> <item>{options, [string()]}</item> - <item>{bits, integer()} - In ssh version 1 files</item> - <tag>known_host attributes - see man sshd</tag> + <item><p>{bits, integer()} - In SSH version 1 files.</p></item> + <tag>known_host attributes - see manual page for sshd.</tag> <item>{hostnames, [string()]}</item> <item>{comment, string()}</item> - <item>{bits, integer()} - In ssh version 1 files</item> + <item><p>{bits, integer()} - In SSH version 1 files.</p></item> </taglist> </desc> @@ -719,16 +784,16 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <func> <name>ssh_encode([{Key, Attributes}], Type) -> binary()</name> - <fsummary> Encodes a list of ssh file entries to a binary.</fsummary> + <fsummary>Encodes a list of SSH file entries to a binary.</fsummary> <type> <v>Key = public_key()</v> <v>Attributes = list()</v> <v>Type = ssh_file()</v> </type> <desc> - <p>Encodes a list of ssh file entries (public keys and attributes) to a binary. Possible - attributes depends on the file type, see <seealso - marker="#ssh_decode-2"> ssh_decode/2 </seealso></p> + <p>Encodes a list of SSH file entries (public keys and attributes) to a binary. Possible + attributes depend on the file type, see <seealso + marker="#ssh_decode-2"> ssh_decode/2 </seealso>.</p> </desc> </func> @@ -737,14 +802,14 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <fsummary>Verifies a digital signature.</fsummary> <type> <v>Msg = binary() | {digest,binary()}</v> - <d>The msg is either the binary "plain text" data - or it is the hashed value of "plain text" i.e. the digest.</d> + <d>The <c>Msg</c> is either the binary "plain text" data + or it is the hashed value of "plain text", that is, the digest.</d> <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> <v>Signature = binary()</v> <v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v> </type> <desc> - <p>Verifies a digital signature</p> + <p>Veryfies a digital signature.</p> </desc> </func> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index a7dfc41449..fc2a74a353 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2014</year> + <year>2015</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -23,7 +23,7 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>Public key records</title> + <title>Public-Key Records</title> <prepared>Ingela Anderton Andin</prepared> <responsible></responsible> <docno></docno> @@ -34,28 +34,85 @@ <file>public_key_records.xml</file> </header> - <p>This chapter briefly describes Erlang records derived from ASN1 - specifications used to handle public and private keys. - The intent is to describe the data types - and not to specify the semantics of each component. For information on the - semantics, please see the relevant standards and RFCs.</p> + <p>This chapter briefly describes Erlang records derived from ASN.1 + specifications used to handle public key infrastructure. + The scope is to describe the data types of each component, + not the semantics. For information on the + semantics, refer to the relevant standards and RFCs linked in the sections below.</p> <p>Use the following include directive to get access to the - records and constant macros described in the following sections.</p> + records and constant macros described in the following sections:</p> <code> -include_lib("public_key/include/public_key.hrl"). </code> - <section> - <title>Common Data Types</title> + <section> + <title>Data Types</title> <p>Common non-standard Erlang - data types used to described the record fields in the - below sections are defined in <seealso - marker="public_key">public key reference manual </seealso></p> - </section> + data types used to describe the record fields in the + following sections and which are not defined in the Public Key <seealso + marker="public_key">Reference Manual</seealso> + follows here:</p> + + <taglist> + <tag><c>time() =</c></tag> + <item><p><c>uct_time() | general_time()</c></p></item> + + <tag><c>uct_time() =</c></tag> + <item><p><c>{utcTime, "YYMMDDHHMMSSZ"}</c></p></item> + + <tag><c>general_time() =</c></tag> + <item><p><c>{generalTime, "YYYYMMDDHHMMSSZ"}</c></p></item> + + <tag><c>general_name() =</c></tag> + <item><p><c>{rfc822Name, string()}</c></p> + <p><c>| {dNSName, string()}</c></p> + <p><c>| {x400Address, string()}</c></p> + <p><c>| {directoryName, {rdnSequence, [#AttributeTypeAndValue'{}]}}</c></p> + <p><c>| {eidPartyName, special_string()}</c></p> + <p><c>| {eidPartyName, special_string(), special_string()}</c></p> + <p><c>| {uniformResourceIdentifier, string()}</c></p> + <p><c>| {ipAddress, string()}</c></p> + <p><c>| {registeredId, oid()}</c></p> + <p><c>| {otherName, term()}</c></p> + </item> + + <tag><c>special_string() =</c></tag> + <item><p><c>{teletexString, string()}</c></p> + <p><c>| {printableString, string()}</c></p> + <p><c>| {universalString, string()}</c></p> + <p><c>| {utf8String, binary()}</c></p> + <p><c>| {bmpString, string()}</c></p> + </item> + + <tag><c>dist_reason() =</c></tag> + <item><p><c>unused</c></p> + <p><c>| keyCompromise</c></p> + <p><c>| cACompromise</c></p> + <p><c>| affiliationChanged</c></p> + <p><c>| superseded</c></p> + <p><c>| cessationOfOperation</c></p> + <p><c>| certificateHold</c></p> + <p><c>| privilegeWithdrawn</c></p> + <p><c>| aACompromise</c></p> + </item> + <tag><c>OID_macro() =</c></tag> + <item><p><c>?OID_name()</c></p> + </item> + + <tag><c>OID_name() =</c></tag> + <item><p><c>atom()</c></p> + </item> + + </taglist> + + </section> + <section> - <title>RSA as defined by the PKCS-1 standard and <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 3447 </url></title> + <title>RSA</title> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc3447.txt"> + Rivest-Shamir-Adleman cryptosystem (RSA)</url> keys follows:</p> <code> #'RSAPublicKey'{ @@ -80,16 +137,13 @@ prime, % integer() exponent, % integer() coefficient % integer() - }. - </code> + }. </code> </section> <section> - <title>DSA as defined by - <url href="http://csrc.nist.gov/publications/fips/fips186-3/fips_186-3.pdf"> Digital Signature Standard (NIST FIPS PUB 186-2) </url> - </title> - + <title>DSA</title> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Digigital Signature Algorithm (DSA)</url> keys</p> <code> #'DSAPrivateKey',{ version, % integer() @@ -104,18 +158,18 @@ p, % integer() q, % integer() g % integer() - }. - </code> + }. </code> + </section> <section> - <title>ECC (Elliptic Curve) <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 5480 </url> - </title> + <title>ECDSA </title> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Elliptic Curve Digital Signature Algorithm (ECDSA)</url> keys follows:</p> <code> #'ECPrivateKey'{ version, % integer() - privateKey, % binary() + privateKey, % binary() parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | {'EcpkParameters', {namedCurve, oid()}} | {'EcpkParameters', 'NULL'} % Inherited by CA @@ -126,14 +180,14 @@ version, % integer() fieldID, % #'FieldID'{} curve, % #'Curve'{} - base, % binary() + base, % binary() order, % integer() cofactor % integer() }. #'Curve'{ a, % binary() - b, % binary() + b, % binary() seed % bitstring() - optional }. @@ -144,10 +198,644 @@ }. #'ECPoint'{ - point % binary() - the public key - }. - - </code> + point % binary() - the public key + }.</code> </section> + <section> + <title>PKIX Certificates</title> + <p>Erlang representation of PKIX certificates derived from ASN.1 + specifications see also <url href="http://www.ietf.org/rfc/rfc5280.txt">X509 certificates (RFC 5280)</url>, also referred to as <c>plain</c> type, are as follows:</p> +<code> +#'Certificate'{ + tbsCertificate, % #'TBSCertificate'{} + signatureAlgorithm, % #'AlgorithmIdentifier'{} + signature % bitstring() + }. + +#'TBSCertificate'{ + version, % v1 | v2 | v3 + serialNumber, % integer() + signature, % #'AlgorithmIdentifier'{} + issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} + validity, % #'Validity'{} + subject, % {rdnSequence, [#AttributeTypeAndValue'{}]} + subjectPublicKeyInfo, % #'SubjectPublicKeyInfo'{} + issuerUniqueID, % binary() | asn1_novalue + subjectUniqueID, % binary() | asn1_novalue + extensions % [#'Extension'{}] + }. + +#'AlgorithmIdentifier'{ + algorithm, % oid() + parameters % der_encoded() + }.</code> + +<p>Erlang alternate representation of PKIX certificate, also referred to as <c>otp</c> type</p> + +<code> +#'OTPCertificate'{ + tbsCertificate, % #'OTPTBSCertificate'{} + signatureAlgorithm, % #'SignatureAlgorithm' + signature % bitstring() + }. + +#'OTPTBSCertificate'{ + version, % v1 | v2 | v3 + serialNumber, % integer() + signature, % #'SignatureAlgorithm' + issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} + validity, % #'Validity'{} + subject, % {rdnSequence, [#AttributeTypeAndValue'{}]} + subjectPublicKeyInfo, % #'OTPSubjectPublicKeyInfo'{} + issuerUniqueID, % binary() | asn1_novalue + subjectUniqueID, % binary() | asn1_novalue + extensions % [#'Extension'{}] + }. + +#'SignatureAlgorithm'{ + algorithm, % id_signature_algorithm() + parameters % asn1_novalue | #'Dss-Parms'{} + }.</code> + +<p><c>id_signature_algorithm() = OID_macro()</c></p> + +<p>The available OID names are as follows:</p> +<table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-dsa-with-sha1</cell> + </row> + <row> + <cell align="left" valign="middle">id-dsaWithSHA1 (ISO or OID to above)</cell> + </row> + <row> + <cell align="left" valign="middle">md2WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">md5WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">sha1WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">sha-1WithRSAEncryption (ISO or OID to above)</cell> + </row> + <row> + <cell align="left" valign="middle">sha224WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">sha256WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">sha512WithRSAEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">ecdsa-with-SHA1</cell> + </row> + <tcaption>Signature Algorithm OIDs </tcaption> +</table> + +<p>The data type <c>'AttributeTypeAndValue'</c>, is represented as + the following erlang record:</p> + +<code> +#'AttributeTypeAndValue'{ + type, % id_attributes() + value % term() + }.</code> + +<p>The attribute OID name atoms and their corresponding value types +are as follows:</p> +<table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + <cell align="left" valign="middle"><em>Value Type</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-at-name</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-surname</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-givenName</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-initials </cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-generationQualifier</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-commonName</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-localityName</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-stateOrProvinceName</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-organizationName</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-title</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-dnQualifier</cell> + <cell align="left" valign="middle">{printableString, string()}</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-countryName</cell> + <cell align="left" valign="middle">{printableString, string()}</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-serialNumber</cell> + <cell align="left" valign="middle">{printableString, string()}</cell> + </row> + <row> + <cell align="left" valign="middle">id-at-pseudonym</cell> + <cell align="left" valign="middle">special_string()</cell> + </row> + <tcaption>Attribute OIDs</tcaption> +</table> + +<p>The data types <c>'Validity'</c>, <c>'SubjectPublicKeyInfo'</c>, and +<c>'SubjectPublicKeyInfoAlgorithm'</c> are represented as the following Erlang records:</p> + +<code> +#'Validity'{ + notBefore, % time() + notAfter % time() + }. + +#'SubjectPublicKeyInfo'{ + algorithm, % #AlgorithmIdentifier{} + subjectPublicKey % binary() + }. + +#'SubjectPublicKeyInfoAlgorithm'{ + algorithm, % id_public_key_algorithm() + parameters % public_key_params() + }.</code> + +<p>The public-key algorithm OID name atoms are as follows:</p> +<table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + </row> + <row> + <cell align="left" valign="middle">rsaEncryption</cell> + </row> + <row> + <cell align="left" valign="middle">id-dsa</cell> + </row> + <row> + <cell align="left" valign="middle">dhpublicnumber</cell> + </row> + <row> + <cell align="left" valign="middle">id-keyExchangeAlgorithm</cell> + </row> + <row> + <cell align="left" valign="middle">id-ecPublicKey</cell> + </row> + <tcaption>Public-Key Algorithm OIDs</tcaption> +</table> + +<code> +#'Extension'{ + extnID, % id_extensions() | oid() + critical, % boolean() + extnValue % der_encoded() + }.</code> + +<p><c>id_extensions()</c> + <seealso marker="#StdCertExt">Standard Certificate Extensions</seealso>, + <seealso marker="#PrivIntExt">Private Internet Extensions</seealso>, + <seealso marker="#CRLCertExt">CRL Extensions</seealso> and + <seealso marker="#CRLEntryExt">CRL Entry Extensions</seealso>. +</p> + +</section> + +<section> + <marker id="StdCertExt"></marker> + <title>Standard Certificate Extensions</title> + + <p>The standard certificate extensions OID name atoms and their + corresponding value types are as follows:</p> + + <table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + <cell align="left" valign="middle"><em>Value Type</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-authorityKeyIdentifier</cell> + <cell align="left" valign="middle">#'AuthorityKeyIdentifier'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-subjectKeyIdentifier</cell> + <cell align="left" valign="middle">oid()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-keyUsage</cell> + <cell align="left" valign="middle">[key_usage()]</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-privateKeyUsagePeriod</cell> + <cell align="left" valign="middle">#'PrivateKeyUsagePeriod'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-certificatePolicies</cell> + <cell align="left" valign="middle">#'PolicyInformation'{}</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-policyMappings</cell> + <cell align="left" valign="middle">#'PolicyMappings_SEQOF'{}</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-subjectAltName</cell> + <cell align="left" valign="middle">general_name()</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-issuerAltName</cell> + <cell align="left" valign="middle">general_name()</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-subjectDirectoryAttributes</cell> + <cell align="left" valign="middle"> [#'Attribute'{}]</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-basicConstraints</cell> + <cell align="left" valign="middle">#'BasicConstraints'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-nameConstraints</cell> + <cell align="left" valign="middle">#'NameConstraints'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-policyConstraints</cell> + <cell align="left" valign="middle">#'PolicyConstraints'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-extKeyUsage</cell> + <cell align="left" valign="middle">[id_key_purpose()]</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-cRLDistributionPoints</cell> + <cell align="left" valign="middle">[#'DistributionPoint'{}]</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-inhibitAnyPolicy</cell> + <cell align="left" valign="middle">integer()</cell> + </row> + + <row> + <cell align="left" valign="middle">id-ce-freshestCRL</cell> + <cell align="left" valign="middle">[#'DistributionPoint'{}]</cell> + </row> + + + <tcaption>Standard Certificate Extensions</tcaption> + </table> + + <p>Here:</p> + <taglist> + <tag><c>key_usage()</c></tag> + <item>= <p><c>digitalSignature</c></p> + <p><c>| nonRepudiation</c></p> + <p><c>| keyEncipherment</c></p> + <p><c>| dataEncipherment</c></p> + <p><c>| keyAgreement</c></p> + <p><c>| keyCertSign</c></p> + <p><c>| cRLSign</c></p> + <p><c>| encipherOnly</c></p> + <p><c>| decipherOnly </c></p> + </item> + </taglist> + + <p>And for <c>id_key_purpose()</c>:</p> + +<table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-serverAuth</cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-clientAuth</cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-codeSigning</cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-emailProtection</cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-timeStamping</cell> + </row> + <row> + <cell align="left" valign="middle">id-kp-OCSPSigning</cell> + </row> + <tcaption>Key Purpose OIDs</tcaption> +</table> + + <code> +#'AuthorityKeyIdentifier'{ + keyIdentifier, % oid() + authorityCertIssuer, % general_name() + authorityCertSerialNumber % integer() + }. + +#'PrivateKeyUsagePeriod'{ + notBefore, % general_time() + notAfter % general_time() + }. + +#'PolicyInformation'{ + policyIdentifier, % oid() + policyQualifiers % [#PolicyQualifierInfo{}] + }. + +#'PolicyQualifierInfo'{ + policyQualifierId, % oid() + qualifier % string() | #'UserNotice'{} + }. + +#'UserNotice'{ + noticeRef, % #'NoticeReference'{} + explicitText % string() + }. + +#'NoticeReference'{ + organization, % string() + noticeNumbers % [integer()] + }. + +#'PolicyMappings_SEQOF'{ + issuerDomainPolicy, % oid() + subjectDomainPolicy % oid() + }. + +#'Attribute'{ + type, % oid() + values % [der_encoded()] + }). + +#'BasicConstraints'{ + cA, % boolean() + pathLenConstraint % integer() + }). + +#'NameConstraints'{ + permittedSubtrees, % [#'GeneralSubtree'{}] + excludedSubtrees % [#'GeneralSubtree'{}] + }). + +#'GeneralSubtree'{ + base, % general_name() + minimum, % integer() + maximum % integer() + }). + +#'PolicyConstraints'{ + requireExplicitPolicy, % integer() + inhibitPolicyMapping % integer() + }). + +#'DistributionPoint'{ + distributionPoint, % {fullName, [general_name()]} | {nameRelativeToCRLIssuer, + [#AttributeTypeAndValue{}]} + reasons, % [dist_reason()] + cRLIssuer % [general_name()] + }).</code> + +</section> + + <section> + <marker id="PrivIntExt"></marker> + <title>Private Internet Extensions</title> + + <p>The private internet extensions OID name atoms and their corresponding value + types are as follows:</p> + + <table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + <cell align="left" valign="middle"><em>Value Type</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-pe-authorityInfoAccess</cell> + <cell align="left" valign="middle">[#'AccessDescription'{}]</cell> + </row> + <row> + <cell align="left" valign="middle">id-pe-subjectInfoAccess</cell> + <cell align="left" valign="middle">[#'AccessDescription'{}]</cell> + </row> + <tcaption>Private Internet Extensions</tcaption> + </table> + +<code> +#'AccessDescription'{ + accessMethod, % oid() + accessLocation % general_name() + }).</code> + + </section> + +<section> + <title>CRL and CRL Extensions Profile</title> + + <p>Erlang representation of CRL and CRL extensions profile + derived from ASN.1 specifications and RFC 5280 are as follows:</p> + + <code> +#'CertificateList'{ + tbsCertList, % #'TBSCertList{} + signatureAlgorithm, % #'AlgorithmIdentifier'{} + signature % bitstring() + }). + +#'TBSCertList'{ + version, % v2 (if defined) + signature, % #AlgorithmIdentifier{} + issuer, % {rdnSequence, [#AttributeTypeAndValue'{}]} + thisUpdate, % time() + nextUpdate, % time() + revokedCertificates, % [#'TBSCertList_revokedCertificates_SEQOF'{}] + crlExtensions % [#'Extension'{}] + }). + +#'TBSCertList_revokedCertificates_SEQOF'{ + userCertificate, % integer() + revocationDate, % timer() + crlEntryExtensions % [#'Extension'{}] + }).</code> + + <section> + <marker id="CRLCertExt"></marker> + <title>CRL Extensions</title> + + <p>The CRL extensions OID name atoms and their corresponding value types are as follows:</p> + + + <table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + <cell align="left" valign="middle"><em>Value Type</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-authorityKeyIdentifier</cell> + <cell align="left" valign="middle">#'AuthorityKeyIdentifier{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-issuerAltName</cell> + <cell align="left" valign="middle">{rdnSequence, [#AttributeTypeAndValue'{}]}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-cRLNumber</cell> + <cell align="left" valign="middle">integer()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-deltaCRLIndicator</cell> + <cell align="left" valign="middle">integer()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-issuingDistributionPoint</cell> + <cell align="left" valign="middle">#'IssuingDistributionPoint'{}</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-freshestCRL</cell> + <cell align="left" valign="middle">[#'Distributionpoint'{}]</cell> + </row> + + <tcaption>CRL Extensions</tcaption> + </table> + + <p>Here, the data type <c>'IssuingDistributionPoint'</c> is represented as + the following Erlang record:</p> + + <code> +#'IssuingDistributionPoint'{ + distributionPoint, % {fullName, [general_name()]} | {nameRelativeToCRLIssuer, + [#AttributeTypeAndValue'{}]} + onlyContainsUserCerts, % boolean() + onlyContainsCACerts, % boolean() + onlySomeReasons, % [dist_reason()] + indirectCRL, % boolean() + onlyContainsAttributeCerts % boolean() + }).</code> + </section> + + <section> + <marker id="CRLEntryExt"></marker> + <title>CRL Entry Extensions</title> + + <p>The CRL entry extensions OID name atoms and their corresponding value types are as follows:</p> + + <table> + <row> + <cell align="left" valign="middle"><em>OID Name</em></cell> + <cell align="left" valign="middle"><em>Value Type</em></cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-cRLReason</cell> + <cell align="left" valign="middle">crl_reason()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-holdInstructionCode</cell> + <cell align="left" valign="middle">oid()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-invalidityDate</cell> + <cell align="left" valign="middle">general_time()</cell> + </row> + <row> + <cell align="left" valign="middle">id-ce-certificateIssuer</cell> + <cell align="left" valign="middle">general_name()</cell> + </row> + <tcaption>CRL Entry Extensions</tcaption> + </table> + + + <p>Here:</p> + <taglist> + <tag><c>crl_reason()</c></tag> + <item>= <p><c>unspecified</c></p> + <p><c>| keyCompromise</c></p> + <p><c>| cACompromise</c></p> + <p><c>| affiliationChanged</c></p> + <p><c>| superseded</c></p> + <p><c>| cessationOfOperation</c></p> + <p><c>| certificateHold</c></p> + <p><c>| removeFromCRL</c></p> + <p><c>| privilegeWithdrawn</c></p> + <p><c>| aACompromise</c></p> + </item> + </taglist> + + </section> + + <section> + <marker id="PKCS10"></marker> + <title>PKCS#10 Certification Request</title> + <p>Erlang representation of a PKCS#10 certification request + derived from ASN.1 specifications and RFC 5280 are as follows:</p> + <code> +#'CertificationRequest'{ + certificationRequestInfo #'CertificationRequestInfo'{}, + signatureAlgorithm #'CertificationRequest_signatureAlgorithm'{}}. + signature bitstring() + } + +#'CertificationRequestInfo'{ + version atom(), + subject {rdnSequence, [#AttributeTypeAndValue'{}]} , + subjectPKInfo #'CertificationRequestInfo_subjectPKInfo'{}, + attributes [#'AttributePKCS-10' {}] + } + +#'CertificationRequestInfo_subjectPKInfo'{ + algorithm #'CertificationRequestInfo_subjectPKInfo_algorithm'{} + subjectPublicKey bitstring() + } + +#'CertificationRequestInfo_subjectPKInfo_algorithm'{ + algorithm = oid(), + parameters = der_encoded() +} + +#'CertificationRequest_signatureAlgorithm'{ + algorithm = oid(), + parameters = der_encoded() + } + +#'AttributePKCS-10'{ + type = oid(), + values = [der_encoded()] +} </code> + </section> +</section> </chapter> diff --git a/lib/public_key/doc/src/ref_man.xml b/lib/public_key/doc/src/ref_man.xml index b7078891d4..9c80cf4b9f 100644 --- a/lib/public_key/doc/src/ref_man.xml +++ b/lib/public_key/doc/src/ref_man.xml @@ -31,8 +31,8 @@ <file>ref_man.xml</file> </header> <description> - <p> Provides functions to handle public key infrastructure - from RFC 3280 (X.509 certificates) and some parts of the PKCS-standard. + <p>The <c>public_key</c> application provides functions to handle public-key infrastructure + from RFC 3280 (X.509 certificates) and parts of the PKCS standard. </p> </description> <xi:include href="public_key.xml"/> diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index 450bd7e35f..03e4bedf3d 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -22,48 +22,50 @@ </legalnotice> <title>Getting Started</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> <file>using_public_key.xml</file> </header> - <section> - <title>General information</title> + <p>This section describes examples of how to use the + Public Key API. Keys and certificates used in the following + sections are generated only for testing the Public Key + application.</p> - <p> This chapter is dedicated to showing some - examples of how to use the public_key API. Keys and certificates - used in the following sections are generated only for the purpose - of testing the public key application.</p> + <p>Some shell printouts in the following examples + are abbreviated for increased readability.</p> - <p>Note that some shell printouts, in the following examples, - have been abbreviated for increased readability.</p> + + <section> + <title>PEM Files</title> + <p>Public-key data (keys, certificates, and so on) can be stored in + Privacy Enhanced Mail (PEM) format. + The PEM files have the following structure:</p> - </section> + <code> + <text> + -----BEGIN <SOMETHING>----- + <Attribute> : <Value> + <Base64 encoded DER data> + -----END <SOMETHING>----- + <text></code> - <section> - <title>PEM files</title> - <p> Public key data (keys, certificates etc) may be stored in PEM format. PEM files - comes from the Private Enhanced Mail Internet standard and has a - structure that looks like this:</p> - - <code><text> - -----BEGIN <SOMETHING>----- - <Attribute> : <Value> - <Base64 encoded DER data> - -----END <SOMETHING>----- - <text></code> - - <p>A file can contain several BEGIN/END blocks. Text lines between - blocks are ignored. Attributes, if present, are currently ignored except - for <c>Proc-Type</c> and <c>DEK-Info</c> that are used when the DER data is - encrypted.</p> + <p>A file can contain several <c>BEGIN/END</c> blocks. Text lines between + blocks are ignored. Attributes, if present, are ignored except + for <c>Proc-Type</c> and <c>DEK-Info</c>, which are used when <c>DER</c> + data is encrypted.</p> <section> - <title>DSA private key</title> + <title>DSA Private Key</title> + <p>A DSA private key can look as follows:</p> + <note><p>File handling is not done by the Public Key application.</p></note> - <p>Note file handling is not done by the public_key application. </p> <code>1> {ok, PemBin} = file:read_file("dsa.pem"). {ok,<<"-----BEGIN DSA PRIVATE KEY-----\nMIIBuw"...>>}</code> - <p>This PEM file only has one entry, a private DSA key.</p> + <p>The following PEM file has only one entry, a private DSA key:</p> <code>2> [DSAEntry] = public_key:pem_decode(PemBin). [{'DSAPrivateKey',<<48,130,1,187,2,1,0,2,129,129,0,183, 179,230,217,37,99,144,157,21,228,204, @@ -80,21 +82,20 @@ </section> <section> - <title>RSA private key encrypted with a password.</title> + <title>RSA Private Key with Password</title> + <p>An RSA private key encrypted with a password can look as follows:</p> <code>1> {ok, PemBin} = file:read_file("rsa.pem"). {ok,<<"Bag Attribut"...>>}</code> - <p>This PEM file only has one entry a private RSA key.</p> + <p>The following PEM file has only one entry, a private RSA key:</p> <code>2>[RSAEntry] = public_key:pem_decode(PemBin). [{'RSAPrivateKey',<<224,108,117,203,152,40,15,77,128,126, 221,195,154,249,85,208,202,251,109, 119,120,57,29,89,19,9,...>>, - {"DES-EDE3-CBC",<<"kÙeø¼pµL">>}}] + {"DES-EDE3-CBC",<<"kÙeø¼pµL">>}}]</code> - </code> - - <p>In this example the password is "abcd1234".</p> + <p>In this following example, the password is <c>"abcd1234"</c>:</p> <code>3> Key = public_key:pem_entry_decode(RSAEntry, "abcd1234"). #'RSAPrivateKey'{version = 'two-prime', modulus = 1112355156729921663373...2737107, @@ -110,11 +111,12 @@ <section> <title>X509 Certificates</title> + <p>The following is an example of X509 certificates:</p> <code>1> {ok, PemBin} = file:read_file("cacerts.pem"). {ok,<<"-----BEGIN CERTIFICATE-----\nMIIC7jCCAl"...>>}</code> - <p>This file includes two certificates</p> + <p>The following file includes two certificates:</p> <code>2> [CertEntry1, CertEntry2] = public_key:pem_decode(PemBin). [{'Certificate',<<48,130,2,238,48,130,2,87,160,3,2,1,2,2, 9,0,230,145,97,214,191,2,120,150,48,13, @@ -124,7 +126,7 @@ 1,48,13,6,9,42,134,72,134,247,...>>>, not_encrypted}]</code> - <p>Certificates may of course be decoded as usual ... </p> + <p>Certificates can be decoded as usual:</p> <code>2> Cert = public_key:pem_entry_decode(CertEntry1). #'Certificate'{ tbsCertificate = @@ -210,24 +212,24 @@ algorithm = {1,2,840,113549,1,1,5}, parameters = <<5,0>>}, signature = - {0, - <<163,186,7,163,216,152,63,47,154,234,139,73,154,96,120, - 165,2,52,196,195,109,167,192,...>>}} -</code> - - <p> Parts of certificates can be decoded with - public_key:der_decode/2 using that parts ASN.1 type. - Although application specific certificate - extension requires application specific ASN.1 decode/encode-functions. - Example, the first value of the rdnSequence above is of ASN.1 type - 'X520CommonName'. ({2,5,4,3} = ?id-at-commonName)</p> + <<163,186,7,163,216,152,63,47,154,234,139,73,154,96,120, + 165,2,52,196,195,109,167,192,...>>}</code> + + <p>Parts of certificates can be decoded with + <c>public_key:der_decode/2</c>, using the ASN.1 type of that part. + However, an application-specific certificate extension requires + application-specific ASN.1 decode/encode-functions. + In the recent example, the first value of <c>rdnSequence</c> is + of ASN.1 type <c>'X520CommonName'. ({2,5,4,3} = ?id-at-commonName)</c>:</p> <code>public_key:der_decode('X520CommonName', <<19,8,101,114,108,97,110,103,67,65>>). {printableString,"erlangCA"}</code> - <p>... but certificates can also be decode using the pkix_decode_cert/2 that - can customize and recursively decode standard parts of a certificate.</p> + <p>However, certificates can also be decoded using <c>pkix_decode_cert/2</c>, + which can customize and recursively decode standard parts of a certificate:</p> + <code>3>{_, DerCert, _} = CertEntry1.</code> + <code>4> public_key:pkix_decode_cert(DerCert, otp). #'OTPCertificate'{ tbsCertificate = @@ -314,30 +316,27 @@ algorithm = {1,2,840,113549,1,1,5}, parameters = 'NULL'}, signature = - {0, <<163,186,7,163,216,152,63,47,154,234,139,73,154,96,120, - 165,2,52,196,195,109,167,192,...>>}} -</code> + 165,2,52,196,195,109,167,192,...>>}</code> - <p>This call is equivalent to public_key:pem_entry_decode(CertEntry1)</p> + <p>This call is equivalent to <c>public_key:pem_entry_decode(CertEntry1)</c>:</p> <code>5> public_key:pkix_decode_cert(DerCert, plain). -#'Certificate'{ ...} -</code> +#'Certificate'{ ...}</code> </section> <section> - <title>Encoding public key data to PEM format</title> + <title>Encoding Public-Key Data to PEM Format</title> - <p>If you have public key data and and want to create a PEM file - you can do that by calling the functions - public_key:pem_entry_encode/2 and pem_encode/1 and then saving the - result to a file. For example assume you have PubKey = - 'RSAPublicKey'{} then you can create a PEM-"RSA PUBLIC KEY" file - (ASN.1 type 'RSAPublicKey') or a PEM-"PUBLIC KEY" file - ('SubjectPublicKeyInfo' ASN.1 type).</p> + <p>If you have public-key data and want to create a PEM file + this can be done by calling functions + <c>public_key:pem_entry_encode/2</c> and <c>pem_encode/1</c> and + saving the result to a file. For example, assume that you have + <c>PubKey = 'RSAPublicKey'{}</c>. Then you can create a PEM-"RSA PUBLIC KEY" + file (ASN.1 type <c>'RSAPublicKey'</c>) or a PEM-"PUBLIC KEY" file + (<c>'SubjectPublicKeyInfo'</c> ASN.1 type).</p> - <p> The second element of the PEM-entry will be the ASN.1 DER encoded - key data.</p> + <p>The second element of the PEM-entry is the ASN.1 <c>DER</c> encoded + key data:</p> <code>1> PemEntry = public_key:pem_entry_encode('RSAPublicKey', RSAPubKey). {'RSAPublicKey', <<48,72,...>>, not_encrypted} @@ -348,7 +347,7 @@ 3> file:write_file("rsa_pub_key.pem", PemBin). ok</code> - <p> or </p> + <p>or:</p> <code>1> PemEntry = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). {'SubjectPublicKeyInfo', <<48,92...>>, not_encrypted} @@ -363,96 +362,108 @@ ok</code> </section> <section> - <title>RSA public key cryptography </title> - <p> Suppose you have PrivateKey = #'RSAPrivateKey{}' and the - plaintext Msg = binary() and the corresponding public key - PublicKey = #'RSAPublicKey'{} then you can do the following. - Note that you normally will only do one of the encrypt or - decrypt operations and the peer will do the other. - </p> - - <p>Encrypt with the private key </p> + <title>RSA Public-Key Cryptography</title> + <p>Suppose you have the following private key and a corresponding public key:</p> + <list type="bulleted"> + <item><c>PrivateKey = #'RSAPrivateKey{}'</c> and + the plaintext <c>Msg = binary()</c></item> + <item><c>PublicKey = #'RSAPublicKey'{}</c> + </item> + </list> + <p>Then you can proceed as follows:</p> + + <p>Encrypt with the private key:</p> <code>RsaEncrypted = public_key:encrypt_private(Msg, PrivateKey), Msg = public_key:decrypt_public(RsaEncrypted, PublicKey),</code> - <p>Encrypt with the public key </p> + <p>Encrypt with the public key:</p> <code>RsaEncrypted = public_key:encrypt_public(Msg, PublicKey), Msg = public_key:decrypt_private(RsaEncrypted, PrivateKey),</code> + + <note><p>You normally do only one of the encrypt or decrypt operations, + and the peer does the other. This normaly used in legacy applications + as a primitive digital signature. + </p></note> + </section> <section> - <title>Digital signatures</title> + <title>Digital Signatures</title> - <p> Suppose you have PrivateKey = #'RSAPrivateKey{}'or - #'DSAPrivateKey'{} and the plaintext Msg = binary() and the - corresponding public key PublicKey = #'RSAPublicKey'{} or - {integer(), #'DssParams'{}} then you can do the following. Note - that you normally will only do one of the sign or verify operations - and the peer will do the other. </p> + <p>Suppose you have the following private key and a corresponding public key:</p> + + <list type="bulleted"> + <item><c>PrivateKey = #'RSAPrivateKey{}'</c> or + <c>#'DSAPrivateKey'{}</c> and the plaintext <c>Msg = binary()</c></item> + <item><c>PublicKey = #'RSAPublicKey'{}</c> or + <c>{integer(), #'DssParams'{}}</c></item> + </list> + <p>Then you can proceed as follows:</p> <code>Signature = public_key:sign(Msg, sha, PrivateKey), true = public_key:verify(Msg, sha, Signature, PublicKey),</code> - <p>It might be appropriate to calculate the message digest before - calling sign or verify and then you can use the none as second - argument.</p> + <note><p>You normally do only one of the sign or verify operations, + and the peer does the other.</p></note> + + <p>It can be appropriate to calculate the message digest before + calling <c>sign</c> or <c>verify</c>, and then use <c>none</c> as + second argument:</p> <code>Digest = crypto:sha(Msg), Signature = public_key:sign(Digest, none, PrivateKey), -true = public_key:verify(Digest, none, Signature, PublicKey), - </code> +true = public_key:verify(Digest, none, Signature, PublicKey),</code> </section> <section> - <title>SSH files</title> + <title>SSH Files</title> <p>SSH typically uses PEM files for private keys but has its - own file format for storing public keys. The erlang public_key - application can be used to parse the content of SSH public key files.</p> + own file format for storing public keys. The <c>public_key</c> + application can be used to parse the content of SSH public-key files.</p> <section> - <title> RFC 4716 SSH public key files </title> + <title>RFC 4716 SSH Public-Key Files</title> <p>RFC 4716 SSH files looks confusingly like PEM files, - but there are some differences.</p> + but there are some differences:</p> <code>1> {ok, SshBin} = file:read_file("ssh2_rsa_pub"). {ok, <<"---- BEGIN SSH2 PUBLIC KEY ----\nAAAA"...>>}</code> - <p>This is equivalent to calling public_key:ssh_decode(SshBin, rfc4716_public_key). + <p>This is equivalent to calling <c>public_key:ssh_decode(SshBin, rfc4716_public_key)</c>: </p> <code>2> public_key:ssh_decode(SshBin, public_key). [{#'RSAPublicKey'{modulus = 794430685...91663, - publicExponent = 35}, []}] -</code> + publicExponent = 35}, []}]</code> </section> <section> - <title> Openssh public key format </title> + <title>OpenSSH Public-Key Format</title> + <p>OpenSSH public-key format looks as follows:</p> <code>1> {ok, SshBin} = file:read_file("openssh_dsa_pub"). {ok,<<"ssh-dss AAAAB3Nza"...>>}</code> - <p>This is equivalent to calling public_key:ssh_decode(SshBin, openssh_public_key). + <p>This is equivalent to calling <c>public_key:ssh_decode(SshBin, openssh_public_key)</c>: </p> <code>2> public_key:ssh_decode(SshBin, public_key). [{{15642692...694280725, #'Dss-Parms'{p = 17291273936...696123221, q = 1255626590179665817295475654204371833735706001853, g = 10454211196...480338645}}, - [{comment,"dhopson@VMUbuntu-DSH"}]}] -</code> + [{comment,"dhopson@VMUbuntu-DSH"}]}]</code> </section> <section> - <title> Known hosts - openssh format</title> - + <title>Known Hosts - OpenSSH Format</title> + <p>Known hosts - OpenSSH format looks as follows:</p> <code>1> {ok, SshBin} = file:read_file("known_hosts"). {ok,<<"hostname.domain.com,192.168.0.1 ssh-rsa AAAAB...>>}</code> - <p>Returns a list of public keys and their related attributes - each pair of key and attributes corresponds to one entry in - the known hosts file.</p> + <p>Returns a list of public keys and their related attributes. + Each pair of key and attribute corresponds to one entry in + the known hosts file:</p> <code>2> public_key:ssh_decode(SshBin, known_hosts). [{#'RSAPublicKey'{modulus = 1498979460408...72721699, @@ -461,19 +472,19 @@ true = public_key:verify(Digest, none, Signature, PublicKey), {#'RSAPublicKey'{modulus = 14989794604088...2721699, publicExponent = 35}, [{comment,"[email protected]"}, - {hostnames,["|1|BWO5qDxk/cFH0wa05JLdHn+j6xQ=|rXQvIxh5cDD3C43k5DPDamawVNA="]}]}] -</code> + {hostnames,["|1|BWO5qDxk/cFH0wa05JLdHn+j6xQ=|rXQvIxh5cDD3C43k5DPDamawVNA="]}]}]</code> </section> <section> - <title> Authorized keys - openssh format</title> + <title>Authorized Keys - OpenSSH Format</title> + <p>Authorized keys - OpenSSH format looks as follows:</p> <code>1> {ok, SshBin} = file:read_file("auth_keys"). {ok, <<"command=\"dump /home\",no-pty,no-port-forwarding ssh-rsa AAA...>>}</code> - <p>Returns a list of public keys and their related attributes - each pair of key and attributes corresponds to one entry in - the authorized key file.</p> + <p>Returns a list of public keys and their related attributes. + Each pair of key and attribute corresponds to one entry in + the authorized key file:</p> <code>2> public_key:ssh_decode(SshBin, auth_keys). [{#'RSAPublicKey'{modulus = 794430685...691663, @@ -485,16 +496,15 @@ true = public_key:verify(Digest, none, Signature, PublicKey), #'Dss-Parms'{p = 17291273936185...763696123221, q = 1255626590179665817295475654204371833735706001853, g = 10454211195705...60511039590076780999046480338645}}, - [{comment,"dhopson@VMUbuntu-DSH"}]}] -</code> + [{comment,"dhopson@VMUbuntu-DSH"}]}]</code> </section> <section> - <title> Creating an SSH file from public key data </title> + <title>Creating an SSH File from Public-Key Data</title> <p>If you got a public key <c>PubKey</c> and a related list of attributes <c>Attributes</c> as returned - by ssh_decode/2 you can create a new ssh file for example</p> + by <c>ssh_decode/2</c>, you can create a new SSH file, for example:</p> <code>N> SshBin = public_key:ssh_encode([{PubKey, Attributes}], openssh_public_key), <<"ssh-rsa "...>> N+1> file:write_file("id_rsa.pub", SshBin). diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 41885c684c..579a3ae4a8 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,25 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A new option for handling the SSH_MSG_DEBUG message's + printouts. A fun could be given in the options that will + be called whenever the SSH_MSG_DEBUG message arrives. + This enables the user to format the printout or just + discard it.</p> + <p> + Own Id: OTP-12738 Aux Id: seq12860 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.2.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index d49d3ac2a7..df13442fc6 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -57,29 +57,28 @@ this module, or abstractions to indicate the intended use of the data type, or both:</p> <taglist> - <tag><c>boolean()</c></tag> - <item><p>= <c>true | false</c></p></item> - <tag><c>string()</c></tag> - <item><p>= <c>[byte()]</c></p></item> - <tag><c>ssh_daemon_ref()</c></tag> - <item><p>Opaque to the user, - returned by <c>ssh:daemon/[1,2,3]</c></p></item> - <tag><c>ssh_connection_ref()</c></tag> - <item><p>Opaque to the user, - returned by <c>ssh:connect/3</c></p></item> - <tag><c>ip_address()</c></tag> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> + <tag><c>string() =</c></tag> + <item><p><c>[byte()]</c></p></item> + <tag><c>ssh_daemon_ref() =</c></tag> + <item><p>opaque() - + as returned by <c>ssh:daemon/[1,2,3]</c></p></item> + <tag><c>ssh_connection_ref() =</c></tag> + <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> + <tag><c>ip_address() =</c></tag> <item><p><c>inet::ip_address</c></p></item> - <tag><c>subsystem_spec()</c></tag> - <item><p>= <c>{subsystem_name(), - {channel_callback(), channel_init_args()}}</c></p></item> - <tag><c>subsystem_name()</c></tag> - <item><p>= <c>string()</c></p></item> - <tag><c>channel_callback()</c></tag> - <item><p>= <c>atom()</c> - Name of the Erlang module - implementing the subsystem using the <c>ssh_channel</c> behavior, see - <seealso marker="ssh_channel">ssh_channel(3)</seealso></p></item> - <tag><c>channel_init_args()</c></tag> - <item><p>= <c>list()</c></p></item> + <tag><c>subsystem_spec() =</c></tag> + <item><p><c>{subsystem_name(), + {channel_callback(), channel_init_args()}}</c></p></item> + <tag><c>subsystem_name() =</c></tag> + <item><p><c>string()</c></p></item> + <tag><c>channel_callback() =</c></tag> + <item><p><c>atom()</c> - Name of the Erlang module + implementing the subsystem using the <c>ssh_channel</c> behavior, see + <seealso marker="ssh_channel">ssh_channel(3)</seealso></p></item> + <tag><c>channel_init_args() =</c></tag> + <item><p><c>list()</c></p></item> </taglist> </section> @@ -227,6 +226,13 @@ <item> <p>Sets a time-out on a connection when no channels are active. Defaults to <c>infinity</c>.</p></item> + <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> + <item> + <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> + <p>The default behaviour is ignore the message. + To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p> + </item> + </taglist> </desc> </func> @@ -427,8 +433,16 @@ <item> <p>Provides a fun to implement your own logging when a user disconnects from the server.</p> </item> - </taglist> - </desc> + + <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> + <item> + <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> + <p>The default behaviour is ignore the message. + To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p> + </item> + + </taglist> + </desc> </func> diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml index b8a03c350a..2fdecf9072 100644 --- a/lib/ssh/doc/src/ssh_channel.xml +++ b/lib/ssh/doc/src/ssh_channel.xml @@ -62,22 +62,22 @@ type, or both:</p> <taglist> - <tag><c>boolean()</c></tag> - <item><p>= <c>true | false</c></p></item> - <tag><c>string()</c></tag> - <item><p>= list of ASCII characters</p></item> - <tag><c>timeout()</c></tag> - <item><p>= <c>infinity | integer()</c> in milliseconds</p></item> - <tag><c>ssh_connection_ref()</c></tag> - <item><p>Opaque to the user, returned by - <c>ssh:connect/3</c> or sent to an SSH channel process</p></item> - <tag><c>ssh_channel_id()</c></tag> - <item><p>= <c>integer()</c></p></item> - <tag><c>ssh_data_type_code()</c></tag> - <item><p>= <c>1</c> ("stderr") | <c>0</c> ("normal") are - the valid values, - see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> - Section 5.2</p></item> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> + <tag><c>string() =</c></tag> + <item><p>list of ASCII characters</p></item> + <tag><c>timeout() =</c></tag> + <item><p><c>infinity | integer()</c> in milliseconds</p></item> + <tag><c>ssh_connection_ref() =</c></tag> + <item><p>opaque() -as returned by + <c>ssh:connect/3</c> or sent to an SSH channel process</p></item> + <tag><c>ssh_channel_id() =</c></tag> + <item><p><c>integer()</c></p></item> + <tag><c>ssh_data_type_code() =</c></tag> + <item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are + the valid values, + see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> + Section 5.2</p></item> </taglist> </section> diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml index a8dda042c9..9a892d71fd 100644 --- a/lib/ssh/doc/src/ssh_client_key_api.xml +++ b/lib/ssh/doc/src/ssh_client_key_api.xml @@ -50,16 +50,16 @@ <seealso marker="public_key:public_key_records"> public_key user's guide:</seealso> </p> <taglist> - <tag><c>boolean()</c></tag> - <item><p>= <c>true | false</c></p></item> - <tag><c>string()</c></tag> - <item><p>= <c>[byte()]</c></p></item> - <tag><c>public_key()</c></tag> - <item><p>= <c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> - <tag><c>private_key()</c></tag> - <item><p>= <c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> - <tag><c>public_key_algorithm()</c></tag> - <item><p>= <c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> + <tag><c>string() =</c></tag> + <item><p><c>[byte()]</c></p></item> + <tag><c>public_key() =</c></tag> + <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <tag><c>private_key() =</c></tag> + <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <tag><c>public_key_algorithm() =</c></tag> + <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> </taglist> </section> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index 669a361db9..5422633dc3 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -56,29 +56,29 @@ type, or both:</p> <taglist> - <tag><c>boolean()</c></tag> - <item><p>= <c>true | false </c></p></item> - <tag><c>string()</c></tag> - <item><p>= list of ASCII characters</p></item> - <tag><c>timeout()</c></tag> - <item><p>= <c>infinity | integer()</c> in milliseconds</p></item> - <tag><c>ssh_connection_ref()</c></tag> - <item><p>Opaque to the user, returned by - <c>ssh:connect/3</c> or sent to an SSH channel processes</p></item> - <tag><c>ssh_channel_id()</c></tag> - <item><p>= <c>integer()</c></p></item> - <tag><c>ssh_data_type_code()</c></tag> - <item><p>= <c>1</c> ("stderr") | <c>0</c> ("normal") are + <tag><c>boolean() =</c></tag> + <item><p><c>true | false </c></p></item> + <tag><c>string() =</c></tag> + <item><p>list of ASCII characters</p></item> + <tag><c>timeout() =</c></tag> + <item><p><c>infinity | integer()</c> in milliseconds</p></item> + <tag><c>ssh_connection_ref() =</c></tag> + <item><p>opaque() -as returned by + <c>ssh:connect/3</c> or sent to an SSH channel processes</p></item> + <tag><c>ssh_channel_id() =</c></tag> + <item><p><c>integer()</c></p></item> + <tag><c>ssh_data_type_code() =</c></tag> + <item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are valid values, see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> Section 5.2.</p></item> - <tag><c>ssh_request_status() ssh_request_status()</c></tag> - <item><p>= <c>success | failure</c></p></item> - <tag><c>event()</c></tag> - <item><p>= <c>{ssh_cm, ssh_connection_ref(), ssh_event_msg()}</c></p></item> - <tag><c>ssh_event_msg()</c></tag> - <item><p>= <c>data_events() | status_events() | terminal_events()</c></p></item> - <tag><c>reason()</c></tag> - <item><p>= <c>timeout | closed</c></p></item> + <tag><c>ssh_request_status() =</c></tag> + <item><p> <c>success | failure</c></p></item> + <tag><c>event() =</c></tag> + <item><p><c>{ssh_cm, ssh_connection_ref(), ssh_event_msg()}</c></p></item> + <tag><c>ssh_event_msg() =</c></tag> + <item><p><c>data_events() | status_events() | terminal_events()</c></p></item> + <tag><c>reason() =</c></tag> + <item><p><c>timeout | closed</c></p></item> </taglist> <taglist> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index 34ce7f7660..73dd90c962 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -50,20 +50,20 @@ <seealso marker="public_key:public_key_records"> public_key user's guide</seealso>. </p> -<taglist> - <tag><c>boolean()</c></tag> - <item><p>= <c>true | false</c></p></item> - <tag><c>string()</c></tag> - <item><p>= <c>[byte()]</c></p></item> - <tag><c>public_key()</c></tag> - <item><p>= <c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> - <tag><c>private_key()</c></tag> - <item><p>= <c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> - <tag><c>public_key_algorithm()</c></tag> - <item><p>= <c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + <taglist> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> + <tag><c>string() =</c></tag> + <item><p><c>[byte()]</c></p></item> + <tag><c>public_key() =</c></tag> + <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <tag><c>private_key() =</c></tag> + <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <tag><c>public_key_algorithm() =</c></tag> + <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> </taglist> </section> - + <funcs> <func> <name>Module:host_key(Algorithm, DaemonOptions) -> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 643130fe6b..fc418bc934 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -43,8 +43,8 @@ </p> <taglist> - <tag><c>ssh_connection_ref()</c></tag> - <item><p>Opaque to the user, returned by <c>ssh:connect/3</c></p></item> + <tag><c>ssh_connection_ref() =</c></tag> + <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> <tag><c>timeout()</c></tag> <item><p>= <c>infinity | integer() in milliseconds. Default infinity.</c></p></item> </taglist> diff --git a/lib/ssh/doc/src/ssh_sftpd.xml b/lib/ssh/doc/src/ssh_sftpd.xml index bc2660f595..8b2497e6a3 100644 --- a/lib/ssh/doc/src/ssh_sftpd.xml +++ b/lib/ssh/doc/src/ssh_sftpd.xml @@ -37,16 +37,16 @@ <section> <title>DATA TYPES</title> <taglist> - <tag><c>subsystem_spec()</c></tag> - <item><p>= <c>{subsystem_name(), {channel_callback(), channel_init_args()}}</c></p></item> - <tag><c>subsystem_name()</c></tag> - <item><p>= <c>"sftp"</c></p></item> - <tag><c>channel_callback()</c></tag> - <item><p>= <c>atom()</c> - Name of the Erlang module implementing the subsystem using the + <tag><c>subsystem_spec() =</c></tag> + <item><p><c>{subsystem_name(), {channel_callback(), channel_init_args()}}</c></p></item> + <tag><c>subsystem_name() =</c></tag> + <item><p><c>"sftp"</c></p></item> + <tag><c>channel_callback() =</c></tag> + <item><p><c>atom()</c> - Name of the Erlang module implementing the subsystem using the <c>ssh_channel</c> behavior, see the <seealso marker="ssh_channel">ssh_channel(3)</seealso> manual page.</p></item> - <tag><c>channel_init_args()</c></tag> - <item><p>= <c>list()</c> - The one given as argument to function <c>subsystem_spec/1</c>.</p></item> + <tag><c>channel_init_args() =</c></tag> + <item><p><c>list()</c> - The one given as argument to function <c>subsystem_spec/1</c>.</p></item> </taglist> </section> <funcs> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index d4b02a024e..71e7d77475 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -312,6 +312,8 @@ handle_option([{disconnectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{failfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{ssh_msg_debug_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); %%Backwards compatibility should not be underscore between ip and v6 in API handle_option([{ip_v6_disabled, Value} | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option({ipv6_disabled, Value}) | SshOptions]); @@ -417,6 +419,8 @@ handle_ssh_option({disconnectfun , Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({failfun, Value} = Opt) when is_function(Value) -> Opt; +handle_ssh_option({ssh_msg_debug_fun, Value} = Opt) when is_function(Value,4) -> + Opt; handle_ssh_option({ipv6_disabled, Value} = Opt) when is_boolean(Value) -> throw({error, {{ipv6_disabled, Opt}, option_no_longer_valid_use_inet_option_instead}}); diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 388c080d99..d532d41009 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -196,15 +196,16 @@ reply_request(_,false, _, _) -> %%-------------------------------------------------------------------- ptty_alloc(ConnectionHandler, Channel, Options) -> ptty_alloc(ConnectionHandler, Channel, Options, infinity). -ptty_alloc(ConnectionHandler, Channel, Options, TimeOut) -> +ptty_alloc(ConnectionHandler, Channel, Options0, TimeOut) -> + Options = backwards_compatible(Options0, []), {Width, PixWidth} = pty_default_dimensions(width, Options), - {Hight, PixHight} = pty_default_dimensions(hight, Options), + {Height, PixHeight} = pty_default_dimensions(height, Options), pty_req(ConnectionHandler, Channel, proplists:get_value(term, Options, os:getenv("TERM", ?DEFAULT_TERMINAL)), proplists:get_value(width, Options, Width), - proplists:get_value(hight, Options, Hight), + proplists:get_value(height, Options, Height), proplists:get_value(pixel_widh, Options, PixWidth), - proplists:get_value(pixel_hight, Options, PixHight), + proplists:get_value(pixel_height, Options, PixHeight), proplists:get_value(pty_opts, Options, []), TimeOut ). %%-------------------------------------------------------------------- @@ -1339,3 +1340,12 @@ decode_ip(Addr) when is_binary(Addr) -> {error,_} -> Addr; {ok,A} -> A end. + +backwards_compatible([], Acc) -> + Acc; +backwards_compatible([{hight, Value} | Rest], Acc) -> + backwards_compatible(Rest, [{height, Value} | Acc]); +backwards_compatible([{pixel_hight, Value} | Rest], Acc) -> + backwards_compatible(Rest, [{height, Value} | Acc]); +backwards_compatible([Value| Rest], Acc) -> + backwards_compatible(Rest, [ Value | Acc]). diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 4dea284071..2c7f132916 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -581,12 +581,12 @@ handle_event(#ssh_msg_disconnect{description = Desc} = DisconnectMsg, _StateName handle_event(#ssh_msg_ignore{}, StateName, State) -> {next_state, StateName, next_packet(State)}; -handle_event(#ssh_msg_debug{always_display = true, message = DbgMsg}, - StateName, State) -> - io:format("DEBUG: ~p\n", [DbgMsg]), - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_debug{}, StateName, State) -> +handle_event(#ssh_msg_debug{always_display = Display, message = DbgMsg, language=Lang}, + StateName, #state{opts = Opts} = State) -> + F = proplists:get_value(ssh_msg_debug_fun, Opts, + fun(_ConnRef, _AlwaysDisplay, _Msg, _Language) -> ok end + ), + catch F(self(), Display, DbgMsg, Lang), {next_state, StateName, next_packet(State)}; handle_event(#ssh_msg_unimplemented{}, StateName, State) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 8669be570e..d6414bab6c 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -240,20 +240,30 @@ key_exchange_first_msg('diffie-hellman-group-exchange-sha1', Ssh0) -> handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) -> {G, P} = dh_group1(), - {Private, Public} = dh_gen_key(G, P, 1024), - K = ssh_math:ipow(E, Private, P), - Key = get_host_key(Ssh0), - H = kex_h(Ssh0, Key, E, Public, K), - H_SIG = sign_host_key(Ssh0, Key, H), - {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_reply{public_host_key = Key, - f = Public, - h_sig = H_SIG - }, Ssh0), - - {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}, - shared_secret = K, - exchanged_hash = H, - session_id = sid(Ssh1, H)}}. + if + 1=<E, E=<(P-1) -> + {Private, Public} = dh_gen_key(G, P, 1024), + K = ssh_math:ipow(E, Private, P), + Key = get_host_key(Ssh0), + H = kex_h(Ssh0, Key, E, Public, K), + H_SIG = sign_host_key(Ssh0, Key, H), + {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_reply{public_host_key = Key, + f = Public, + h_sig = H_SIG + }, Ssh0), + + {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}, + shared_secret = K, + exchanged_hash = H, + session_id = sid(Ssh1, H)}}; + true -> + Error = {error,bad_e_from_peer}, + Disconnect = #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds", + language = "en"}, + throw({Error, Disconnect}) + end. handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> {Private, Public} = dh_gen_key(G,P,1024), @@ -277,7 +287,7 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) -> %% %% Select algorithms handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, h_sig = H_SIG}, - #ssh{keyex_key = {{Private, Public}, {_G, P}}} = Ssh0) -> + #ssh{keyex_key = {{Private, Public}, {_G, P}}} = Ssh0) when 1=<F, F=<(P-1)-> K = ssh_math:ipow(F, Private, P), H = kex_h(Ssh0, HostKey, Public, F, K), @@ -293,7 +303,15 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, description = "Key exchange failed", language = "en"}, throw({Error, Disconnect}) - end. + end; +handle_kexdh_reply(#ssh_msg_kexdh_reply{}, _SSH) -> + Error = {error,bad_f_from_peer}, + Disconnect = #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds", + language = "en"}, + throw({Error, Disconnect}). + handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min, n = _NBits, diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index bd029ad420..242c9a3bd9 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -52,6 +52,8 @@ all() -> ssh_connect_arg4_timeout, packet_size_zero, ssh_daemon_minimal_remote_max_packet_size_option, + ssh_msg_debug_fun_option_client, + ssh_msg_debug_fun_option_server, id_string_no_opt_client, id_string_own_string_client, id_string_random_client, @@ -494,6 +496,94 @@ server_userpassword_option(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +ssh_msg_debug_fun_option_client() -> + [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. +ssh_msg_debug_fun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + Parent = self(), + DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, + + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {ssh_msg_debug_fun,DbgFun}]), + %% Beware, implementation knowledge: + gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + receive + {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> + ct:log("Got expected dbg msg ~p",[X]), + ssh:stop_daemon(Pid); + {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> + ct:log("Got dbg msg but bad ConnectionRef (~p expected) ~p",[ConnectionRef,X]), + ssh:stop_daemon(Pid), + {fail, "Bad ConnectionRef received"}; + {msg_dbg,X} -> + ct:log("Got bad dbg msg ~p",[X]), + ssh:stop_daemon(Pid), + {fail,"Bad msg received"} + after 1000 -> + ssh:stop_daemon(Pid), + {fail,timeout} + end. + +%%-------------------------------------------------------------------- +ssh_msg_debug_fun_option_server() -> + [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. +ssh_msg_debug_fun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, + ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {connectfun, ConnFun}, + {ssh_msg_debug_fun, DbgFun}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connection_pid,Server} -> + %% Beware, implementation knowledge: + gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + receive + {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> + ct:log("Got expected dbg msg ~p",[X]), + ssh:stop_daemon(Pid); + {msg_dbg,X} -> + ct:log("Got bad dbg msg ~p",[X]), + ssh:stop_daemon(Pid), + {fail,"Bad msg received"} + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout2} + end + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout1} + end. + +%%-------------------------------------------------------------------- known_hosts() -> [{doc, "check that known_hosts is updated correctly"}]. known_hosts(Config) when is_list(Config) -> @@ -823,56 +913,62 @@ ssh_daemon_minimal_remote_max_packet_size_option(Config) -> %%-------------------------------------------------------------------- id_string_no_opt_client(Config) -> - {Server, Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect(Host, Port, []), + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [], 1000), receive {id,Server,"SSH-2.0-Erlang/"++Vsn} -> true = expected_ssh_vsn(Vsn); {id,Server,Other} -> ct:fail("Unexpected id: ~s.",[Other]) + after 5000 -> + {fail,timeout} end. %%-------------------------------------------------------------------- id_string_own_string_client(Config) -> - {Server, Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect(Host, Port, [{id_string,"Pelle"}]), + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [{id_string,"Pelle"}], 1000), receive {id,Server,"SSH-2.0-Pelle\r\n"} -> ok; {id,Server,Other} -> ct:fail("Unexpected id: ~s.",[Other]) + after 5000 -> + {fail,timeout} end. %%-------------------------------------------------------------------- id_string_random_client(Config) -> - {Server, Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect(Host, Port, [{id_string,random}]), + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [{id_string,random}], 1000), receive {id,Server,Id="SSH-2.0-Erlang"++_} -> ct:fail("Unexpected id: ~s.",[Id]); {id,Server,Rnd="SSH-2.0-"++_} -> - ct:log("Got ~s.",[Rnd]); + ct:log("Got correct ~s",[Rnd]); {id,Server,Id} -> ct:fail("Unexpected id: ~s.",[Id]) + after 5000 -> + {fail,timeout} end. %%-------------------------------------------------------------------- id_string_no_opt_server(Config) -> {_Server, Host, Port} = std_daemon(Config, []), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000), true = expected_ssh_vsn(Vsn). %%-------------------------------------------------------------------- id_string_own_string_server(Config) -> {_Server, Host, Port} = std_daemon(Config, [{id_string,"Olle"}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000). %%-------------------------------------------------------------------- id_string_random_server(Config) -> {_Server, Host, Port} = std_daemon(Config, [{id_string,random}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000), case Rnd of "Erlang"++_ -> ct:log("Id=~p",[Rnd]), @@ -1183,13 +1279,14 @@ expected_ssh_vsn(Str) -> _:_ -> true %% ssh not started so we dont't know end. - + fake_daemon(_Config) -> Parent = self(), %% start the server Server = spawn(fun() -> - {ok,Sl} = gen_tcp:listen(0,[]), + {ok,Sl} = gen_tcp:listen(0,[{packet,line}]), {ok,{Host,Port}} = inet:sockname(Sl), + ct:log("fake_daemon listening on ~p:~p~n",[Host,Port]), Parent ! {sockname,self(),Host,Port}, Rsa = gen_tcp:accept(Sl), ct:log("Server gen_tcp:accept got ~p",[Rsa]), diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 6fc09876ad..db51f65509 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -271,7 +271,7 @@ ptty_alloc(Config) when is_list(Config) -> {user_interaction, false}]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, - [{term, os:getenv("TERM", ?DEFAULT_TERMINAL)}, {width, 70}, {high, 20}]), + [{term, os:getenv("TERM", ?DEFAULT_TERMINAL)}, {width, 70}, {height, 20}]), ssh:close(ConnectionRef). diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index cdf6870c25..18d98e5efb 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -67,15 +67,15 @@ <taglist> - <tag><c>boolean()</c></tag> - <item><p><c>= true | false</c></p></item> + <tag><c>boolean() =</c></tag> + <item><p><c>true | false</c></p></item> - <tag><c>option()</c></tag> - <item><p><c>= socketoption() | ssloption() | transportoption()</c></p> + <tag><c>option() =</c></tag> + <item><p><c>socketoption() | ssloption() | transportoption()</c></p> </item> - <tag><c>socketoption()</c></tag> - <item><p><c>= proplists:property()</c></p> + <tag><c>socketoption() =</c></tag> + <item><p><c>proplists:property()</c></p> <p>The default socket options are <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p> <p>For valid options, see the @@ -83,32 +83,37 @@ <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> manual pages in Kernel.</p></item> - <tag><marker id="type-ssloption"></marker><c>ssloption()</c></tag> - <item><p><c>= {verify, verify_type()}</c></p> - <p><c>| {verify_fun, {fun(), term()}}</c></p> - <p><c>| {fail_if_no_peer_cert, boolean()} {depth, integer()}</c></p> - <p><c>| {cert, public_key:der_encoded()}</c></p> - <p><c>| {certfile, path()}</c></p> - <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' - | 'PrivateKeyInfo', public_key:der_encoded()}}</c></p> - <p><c>| {keyfile, path()}</c></p> - <p><c>| {password, string()}</c></p> - <p><c>| {cacerts, [public_key:der_encoded()]}</c></p> - <p><c>| {cacertfile, path()}</c></p> - <p><c>| {dh, public_key:der_encoded()}</c></p> - <p><c>| {dhfile, path()}</c></p> - <p><c>| {ciphers, ciphers()}</c></p> - <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, - {srp_identity, {string(), string()}}</c></p> - <p><c>| {reuse_sessions, boolean()}</c></p> - <p><c>| {reuse_session, fun()} {next_protocols_advertised, [binary()]}</c></p> - <p><c>| {client_preferred_next_protocols, {client | server, - [binary()]} | {client | server, [binary()], binary()}}</c></p> - <p><c>| {log_alert, boolean()}</c></p> - <p><c>| {server_name_indication, hostname() | disable}</c></p></item> - - <tag><c>transportoption()</c></tag> - <item><p><c>= {cb_info, {CallbackModule::atom(), DataTag::atom(), + <tag><marker id="type-ssloption"></marker><c>ssloption() =</c></tag> + <item> + <p><c>{verify, verify_type()}</c></p> + <p><c>| {verify_fun, {fun(), term()}}</c></p> + <p><c>| {fail_if_no_peer_cert, boolean()} {depth, integer()}</c></p> + <p><c>| {cert, public_key:der_encoded()}</c></p> + <p><c>| {certfile, path()}</c></p> + <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' + | 'PrivateKeyInfo', public_key:der_encoded()}}</c></p> + <p><c>| {keyfile, path()}</c></p> + <p><c>| {password, string()}</c></p> + <p><c>| {cacerts, [public_key:der_encoded()]}</c></p> + <p><c>| {cacertfile, path()}</c></p> + <p><c>| {dh, public_key:der_encoded()}</c></p> + <p><c>| {dhfile, path()}</c></p> + <p><c>| {ciphers, ciphers()}</c></p> + <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, + {srp_identity, {string(), string()}}</c></p> + <p><c>| {reuse_sessions, boolean()}</c></p> + <p><c>| {reuse_session, fun()} {next_protocols_advertised, [binary()]}</c></p> + <p><c>| {client_preferred_next_protocols, {client | server, + [binary()]} | {client | server, [binary()], binary()}}</c></p> + <p><c>| {log_alert, boolean()}</c></p> + <p><c>| {server_name_indication, hostname() | disable}</c></p> + <p><c>| {sni_hosts, [{hostname(), ssloptions()}]}</c></p> + <p><c>| {sni_fun, SNIfun::fun()}</c></p> + </item> + + <tag><c>transportoption() =</c></tag> + <item><p><c>{cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag:atom()}}</c></p> <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c>. Can be used to customize the transport layer. The callback module must implement a @@ -118,70 +123,73 @@ The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> directly.</p> <taglist> - <tag><c>CallbackModule</c></tag> - <item><p><c>= atom()</c></p></item> - <tag><c>DataTag</c></tag> - <item><p><c>= atom()</c></p> + <tag><c>CallbackModule =</c></tag> + <item><p><c>atom()</c></p></item> + <tag><c>DataTag =</c></tag> + <item><p><c>atom()</c></p> <p>Used in socket data message.</p></item> - <tag><c>ClosedTag</c></tag> - <item><p><c>= atom()</c></p> + <tag><c>ClosedTag =</c></tag> + <item><p><c>atom()</c></p> <p>Used in socket close message.</p></item> </taglist> </item> - <tag><c>verify_type()</c></tag> - <item><p><c>= verify_none | verify_peer</c></p></item> + <tag><c>verify_type() =</c></tag> + <item><p><c>verify_none | verify_peer</c></p></item> - <tag><c>path()</c></tag> - <item><p><c>= string()</c></p> + <tag><c>path() =</c></tag> + <item><p><c>string()</c></p> <p>Represents a file path.</p></item> - <tag><c>public_key:der_encoded()</c></tag> - <item><p><c>= binary()</c></p> + <tag><c>public_key:der_encoded() =</c></tag> + <item><p><c>binary()</c></p> <p>ASN.1 DER-encoded entity as an Erlang binary.</p></item> - <tag><c>host()</c></tag> - <item><p><c>= hostname() | ipaddress()</c></p></item> + <tag><c>host() =</c></tag> + <item><p><c>hostname() | ipaddress()</c></p></item> - <tag><c>hostname()</c></tag> - <item><p><c>= string()</c></p></item> + <tag><c>hostname() =</c></tag> + <item><p><c>string()</c></p></item> - <tag><c>ip_address()</c></tag> - <item><p><c>= {N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6 + <tag><c>ip_address() =</c></tag> + <item><p><c>{N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6 </c></p></item> - <tag><c>sslsocket()</c></tag> - <item><p>Opaque to the user.</p></item> + <tag><c>sslsocket() =</c></tag> + <item><p>opaque()</p></item> - <tag><c>protocol()</c></tag> - <item><p><c>= sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> + <tag><c>protocol() =</c></tag> + <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> - <tag><c>ciphers()</c></tag> + <tag><c>ciphers() =</c></tag> <item><p><c>= [ciphersuite()] | string()</c></p> <p>According to old API.</p></item> - <tag><c>ciphersuite()</c></tag> - <item><p><c>= {key_exchange(), cipher(), hash()}</c></p></item> + <tag><c>ciphersuite() =</c></tag> + <item><p><c>{key_exchange(), cipher(), hash()}</c></p></item> - <tag><c>key_exchange()</c></tag> - <item><p><c>= rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk + <tag><c>key_exchange()=</c></tag> + <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk | rsa_psk | srp_anon | srp_dss | srp_rsa | ecdh_anon | ecdh_ecdsa | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa</c></p></item> - <tag><c>cipher()</c></tag> - <item><p><c>= rc4_128 | des_cbc | '3des_ede_cbc' + <tag><c>cipher() =</c></tag> + <item><p><c>rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm</c></p></item> - <tag><c>hash()</c></tag> - <item><p><c>= md5 | sha</c></p></item> + <tag><c>hash() =</c></tag> + <item><p><c>md5 | sha</c></p></item> - <tag><c>prf_random()</c></tag> - <item><p><c>= client_random | server_random</c></p></item> + <tag><c>prf_random() =</c></tag> + <item><p><c>client_random | server_random</c></p></item> - <tag><c>srp_param_type()</c></tag> - <item><p><c>= srp_1024 | srp_1536 | srp_2048 | srp_3072 + <tag><c>srp_param_type() =</c></tag> + <item><p><c>srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | srp_8192</c></p></item> + <tag><c>SNIfun::fun()</c></tag> + <item><p><c>= fun(ServerName :: string()) -> ssloptions()</c></p></item> + </taglist> </section> @@ -268,7 +276,7 @@ atom()}} | application. It differentiates between the peer certificate and the CA certificates by using <c>valid_peer</c> or <c>valid</c> as second argument to the verification fun. See the - <seealso marker="public_key:cert_records">public_key User's + <seealso marker="public_key:public_key_records">public_key User's Guide</seealso> for definition of <c>#'OTPCertificate'{}</c> and <c>#'Extension'{}</c>.</p> @@ -364,10 +372,10 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid empty argument list. The following arguments may be specified for the internal cache.</p> <taglist> <tag><c>{http, timeout()}</c></tag> - <item> + <item><p> Enables fetching of CRLs specified as http URIs in<seealso - marker="public_key:cert_records"> X509 cerificate extensions.</seealso> - Requires the OTP inets application. + marker="public_key:public_key_records"> X509 cerificate extensions.</seealso> + Requires the OTP inets application.</p> </item> </taglist> </item> @@ -624,7 +632,24 @@ fun(srp, Username :: string(), UserState :: term()) -> selection. If set to <c>false</c> (the default), use the client preference.</p></item> - + <tag><c>{sni_hosts, [{hostname(), ssloptions()}]}</c></tag> + <item><p>If the server receives a SNI (Server Name Indication) from the client + matching a host listed in the <c>sni_hosts</c> option, the speicific options for + that host will override previously specified options. + + The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> + + <tag><c>{sni_fun, SNIfun::fun()}</c></tag> + <item><p>If the server receives a SNI (Server Name Indication) from the client, + the given function will be called to retrive <c>ssloptions()</c> for indicated server. + These options will be merged into predefined <c>ssloptions()</c>. + + The function should be defined as: + <c>fun(ServerName :: string()) -> ssloptions()</c> + and can be specified as a fun or as named <c>fun module:function/1</c> + + The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> + </taglist> </section> @@ -752,6 +777,45 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> + <name>connection_information(SslSocket) -> + {ok, Info} | {error, Reason} </name> + <fsummary>Returns all the connection information. + </fsummary> + <type> + <v>Info = [InfoTuple]</v> + <v>InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname}</v> + <v>CipherSuite = ciphersuite()</v> + <v>ProtocolVersion = protocol()</v> + <v>SNIHostname = string()</v> + <v>Reason = term()</v> + </type> + <desc><p>Return all the connection information containing negotiated protocol version, cipher suite, and the hostname of SNI extension. + Info will be a proplists containing all the connection information on success, otherwise <c>{error, Reason}</c> will be returned.</p> + </desc> + </func> + + <func> + <name>connection_information(SslSocket, Items) -> + {ok, Info} | {error, Reason} </name> + <fsummary>Returns the requested connection information. + </fsummary> + <type> + <v>Items = [Item]</v> + <v>Item = protocol | cipher_suite | sni_hostname</v> + <v>Info = [InfoTuple]</v> + <v>InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname}</v> + <v>CipherSuite = ciphersuite()</v> + <v>ProtocolVersion = protocol()</v> + <v>SNIHostname = string()</v> + <v>Reason = term()</v> + </type> + <desc><p>Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. + <c>{ok, Info}</c> will be returned if it executes sucessfully. The Info is a proplists containing the information you requested. + Otherwise, <c>{error, Reason}</c> will be returned.</p> + </desc> + </func> + + <func> <name>format_error(Reason) -> string()</name> <fsummary>Returns an error string.</fsummary> <type> diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index 1d9353a2cc..9230442ae0 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -47,11 +47,11 @@ <taglist> - <tag><c>cache_ref()</c></tag> - <item> = opaque()</item> - <tag><c>dist_point()</c></tag> - <item> = #'DistributionPoint'{} see <seealso - marker="public_key:cert_records"> X509 certificates records</seealso></item> + <tag><c>cache_ref() =</c></tag> + <item>opaque()</item> + <tag><c>dist_point() =</c></tag> + <item><p>#'DistributionPoint'{} see <seealso + marker="public_key:public_key_records"> X509 certificates records</seealso></p></item> </taglist> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index c89d3874a1..28b5f4ce23 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -40,20 +40,20 @@ <c>ssl_session_cache_api</c>:</p> <taglist> - <tag><c>cache_ref()</c></tag> - <item><p>= <c>opaque()</c></p></item> + <tag><c>cache_ref() =</c></tag> + <item><p><c>opaque()</c></p></item> - <tag><c>key()</c></tag> - <item><p>= <c>{partialkey(), session_id()}</c></p></item> + <tag><c>key() =</c></tag> + <item><p><c>{partialkey(), session_id()}</c></p></item> - <tag><c>partialkey()</c></tag> - <item><p>= <c>opaque()</c></p></item> + <tag><c>partialkey() =</c></tag> + <item><p><c>opaque()</c></p></item> - <tag><c>session_id()</c></tag> - <item><p>= <c>binary()</c></p></item> + <tag><c>session_id() =</c></tag> + <item><p><c>binary()</c></p></item> - <tag><c>session()</c></tag> - <item><p>= <c>opaque()</c></p></item> + <tag><c>session()</c> =</tag> + <item><p><c>opaque()</c></p></item> </taglist> </section> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6461f64c1c..225a9be66f 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -38,11 +38,13 @@ %% SSL/TLS protocol handling -export([cipher_suites/0, cipher_suites/1, suite_definition/1, connection_info/1, versions/0, session_info/1, format_error/1, - renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1]). + renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1, + connection_information/1, connection_information/2]). %% Misc --export([random_bytes/1]). +-export([random_bytes/1, handle_options/2]). -deprecated({negotiated_next_protocol, 1, next_major_release}). +-deprecated({connection_info, 1, next_major_release}). -include("ssl_api.hrl"). -include("ssl_internal.hrl"). @@ -286,16 +288,42 @@ controlling_process(#sslsocket{pid = {Listen, is_pid(NewOwner) -> Transport:controlling_process(Listen, NewOwner). + +%%-------------------------------------------------------------------- +-spec connection_information(#sslsocket{}) -> {ok, list()} | {error, reason()}. +%% +%% Description: Return SSL information for the connection +%%-------------------------------------------------------------------- +connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:connection_information(Pid); +connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. + + +%%-------------------------------------------------------------------- +-spec connection_information(#sslsocket{}, [atom]) -> {ok, list()} | {error, reason()}. +%% +%% Description: Return SSL information for the connection +%%-------------------------------------------------------------------- +connection_information(#sslsocket{} = SSLSocket, Items) -> + case connection_information(SSLSocket) of + {ok, I} -> + {ok, lists:filter(fun({K, _}) -> lists:foldl(fun(K1, Acc) when K1 =:= K -> Acc + 1; (_, Acc) -> Acc end, 0, Items) > 0 end, I)}; + E -> + E + end. + %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_record:tls_atom_version(), ssl_cipher:erl_cipher_suite()}} | {error, reason()}. %% %% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> - ssl_connection:info(Pid); -connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - {error, enotconn}. +connection_info(#sslsocket{} = SSLSocket) -> + case connection_information(SSLSocket) of + {ok, Result} -> + {ok, {proplists:get_value(protocol, Result), proplists:get_value(cipher_suite, Result)}}; + Error -> + Error + end. %%-------------------------------------------------------------------- -spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. @@ -671,6 +699,8 @@ handle_options(Opts0) -> handle_option(client_preferred_next_protocols, Opts, undefined)), log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), + sni_hosts = handle_option(sni_hosts, Opts, []), + sni_fun = handle_option(sni_fun, Opts, undefined), honor_cipher_order = handle_option(honor_cipher_order, Opts, false), protocol = proplists:get_value(protocol, Opts, tls), padding_check = proplists:get_value(padding_check, Opts, true), @@ -687,7 +717,7 @@ handle_options(Opts0) -> user_lookup_fun, psk_identity, srp_identity, ciphers, reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, - erl_dist, alpn_advertised_protocols, + erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun, alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, @@ -704,6 +734,18 @@ handle_options(Opts0) -> inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb }}. +handle_option(sni_fun, Opts, Default) -> + OptFun = validate_option(sni_fun, + proplists:get_value(sni_fun, Opts, Default)), + OptHosts = proplists:get_value(sni_hosts, Opts, undefined), + case {OptFun, OptHosts} of + {Default, _} -> + Default; + {_, undefined} -> + OptFun; + _ -> + throw({error, {conflict_options, [sni_fun, sni_hosts]}}) + end; handle_option(OptionName, Opts, Default) -> validate_option(OptionName, proplists:get_value(OptionName, Opts, Default)). @@ -881,6 +923,20 @@ validate_option(server_name_indication, disable) -> disable; validate_option(server_name_indication, undefined) -> undefined; +validate_option(sni_hosts, []) -> + []; +validate_option(sni_hosts, [{Hostname, SSLOptions} | Tail]) when is_list(Hostname) -> + RecursiveSNIOptions = proplists:get_value(sni_hosts, SSLOptions, undefined), + case RecursiveSNIOptions of + undefined -> + [{Hostname, validate_options(SSLOptions)} | validate_option(sni_hosts, Tail)]; + _ -> + throw({error, {options, {sni_hosts, RecursiveSNIOptions}}}) + end; +validate_option(sni_fun, undefined) -> + undefined; +validate_option(sni_fun, Fun) when is_function(Fun) -> + Fun; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; validate_option(padding_check, Value) when is_boolean(Value) -> @@ -896,6 +952,12 @@ validate_option(crl_cache, {Cb, {_Handle, Options}} = Value) when is_atom(Cb) an validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). + +validate_options([]) -> + []; +validate_options([{Opt, Value} | Tail]) -> + [{Opt, validate_option(Opt, Value)} | validate_options(Tail)]. + validate_npn_ordering(client) -> ok; validate_npn_ordering(server) -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 4a839872a6..64fa7bab0d 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -41,8 +41,9 @@ %% User Events -export([send/2, recv/3, close/1, shutdown/2, - new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, - peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5 + new_user/2, get_opts/2, set_opts/2, session_info/1, + peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5, + connection_information/1 ]). -export([handle_session/7]). @@ -161,6 +162,14 @@ recv(Pid, Length, Timeout) -> sync_send_all_state_event(Pid, {recv, Length, Timeout}). %%-------------------------------------------------------------------- +-spec connection_information(pid()) -> {ok, list()} | {error, reason()}. +%% +%% Description: Get the SNI hostname +%%-------------------------------------------------------------------- +connection_information(Pid) when is_pid(Pid) -> + sync_send_all_state_event(Pid, connection_information). + +%%-------------------------------------------------------------------- -spec close(pid()) -> ok | {error, reason()}. %% %% Description: Close an ssl connection @@ -214,14 +223,6 @@ set_opts(ConnectionPid, Options) -> sync_send_all_state_event(ConnectionPid, {set_opts, Options}). %%-------------------------------------------------------------------- --spec info(pid()) -> {ok, {atom(), tuple()}} | {error, reason()}. -%% -%% Description: Returns ssl protocol and cipher used for the connection -%%-------------------------------------------------------------------- -info(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, info). - -%%-------------------------------------------------------------------- -spec session_info(pid()) -> {ok, list()} | {error, reason()}. %% %% Description: Returns info about the ssl session @@ -829,13 +830,6 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, error:Reason -> {error, Reason} end, {reply, Reply, StateName, State, get_timeout(State)}; -handle_sync_event(info, _, StateName, - #state{negotiated_version = Version, - session = #session{cipher_suite = Suite}} = State) -> - - AtomVersion = tls_record:protocol_version(Version), - {reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}}, - StateName, State, get_timeout(State)}; handle_sync_event(session_info, _, StateName, #state{session = #session{session_id = Id, cipher_suite = Suite}} = State) -> @@ -845,7 +839,10 @@ handle_sync_event(session_info, _, StateName, handle_sync_event(peer_certificate, _, StateName, #state{session = #session{peer_certificate = Cert}} = State) -> - {reply, {ok, Cert}, StateName, State, get_timeout(State)}. + {reply, {ok, Cert}, StateName, State, get_timeout(State)}; +handle_sync_event(connection_information, _, StateName, #state{sni_hostname = SNIHostname, session = #session{cipher_suite = CipherSuite}, negotiated_version = Version} = State) -> + {reply, {ok, [{protocol, tls_record:protocol_version(Version)}, {cipher_suite, ssl:suite_definition(CipherSuite)}, {sni_hostname, SNIHostname}]}, StateName, State, get_timeout(State)}. + handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index e569d706af..d95b51132a 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -80,7 +80,8 @@ expecting_finished = false ::boolean(), negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} - tracker :: pid() %% Tracker process for listen socket + tracker :: pid(), %% Tracker process for listen socket + sni_hostname = undefined }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 90f8b8a412..baeae68bc4 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -122,6 +122,8 @@ next_protocol_selector = undefined, %% fun([binary()]) -> binary()) log_alert :: boolean(), server_name_indication = undefined, + sni_hosts :: [{inet:hostname(), [tuple()]}], + sni_fun :: function() | undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? honor_cipher_order = false :: boolean(), diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 0577222980..3304ffcddb 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -398,6 +398,23 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us tracker = Tracker }. + +update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> + SSLOption = + case OrigSSLOptions#ssl_options.sni_fun of + undefined -> + proplists:get_value(SNIHostname, + OrigSSLOptions#ssl_options.sni_hosts); + SNIFun -> + SNIFun(SNIHostname) + end, + case SSLOption of + undefined -> + undefined; + _ -> + ssl:handle_options(SSLOption, OrigSSLOptions) + end. + next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> handle_own_alert(Alert, Version, Current, State); @@ -426,15 +443,17 @@ next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, %% This message should not be included in handshake %% message hashes. Already in negotiation so it will be ignored! ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> + ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, HState0}) -> + HState = handle_sni_extension(Packet, HState0), Version = Packet#client_hello.client_version, Hs0 = ssl_handshake:init_handshake_history(), Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) -> + ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1, + renegotiation = {true, peer}}); + ({Packet, Raw}, {next_state, SName, HState0 = #state{tls_handshake_history=Hs0}}) -> + HState = handle_sni_extension(Packet, HState0), Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1}); + ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1}); (_, StopState) -> StopState end, try @@ -981,3 +1000,32 @@ convert_options_partial_chain(Options, up) -> list_to_tuple(Head ++ [{partial_chain, fun(_) -> unknown_ca end}] ++ Tail); convert_options_partial_chain(Options, down) -> list_to_tuple(proplists:delete(partial_chain, tuple_to_list(Options))). + +handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) -> + case HelloExtensions#hello_extensions.sni of + undefined -> + State0; + #sni{hostname = Hostname} -> + NewOptions = update_ssl_options_from_sni(State0#state.ssl_options, Hostname), + case NewOptions of + undefined -> + State0; + _ -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, Key, DHParams} = + ssl_config:init(NewOptions, State0#state.role), + State0#state{ + session = State0#state.session#session{own_certificate = OwnCert}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbHandle, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = NewOptions, + sni_hostname = Hostname + } + end + end; +handle_sni_extension(_, State0) -> + State0. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 8c45a788a4..886cc7726b 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -53,6 +53,7 @@ MODULES = \ ssl_to_openssl_SUITE \ ssl_ECC_SUITE \ ssl_upgrade_SUITE\ + ssl_sni_SUITE \ make_certs\ erl_make_certs diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 77631f62d3..4a193d48fe 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -81,7 +81,7 @@ all(DataDir, PrivDir, C = #config{}) -> create_rnd(DataDir, PrivDir), % For all requests rootCA(PrivDir, "erlangCA", C), intermediateCA(PrivDir, "otpCA", "erlangCA", C), - endusers(PrivDir, "otpCA", ["client", "server", "revoked"], C), + endusers(PrivDir, "otpCA", ["client", "server", "revoked", "a.server", "b.server"], C), endusers(PrivDir, "erlangCA", ["localhost"], C), %% Create keycert files SDir = filename:join([PrivDir, "server"]), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 50d5fb411f..3495b978b7 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -3445,7 +3445,7 @@ renegotiate_immediately(Socket) -> end, ok = ssl:renegotiate(Socket), {error, renegotiation_rejected} = ssl:renegotiate(Socket), - ct:sleep(?RENEGOTIATION_DISABLE_TIME +1), + ct:sleep(?RENEGOTIATION_DISABLE_TIME + ?SLEEP), ok = ssl:renegotiate(Socket), ct:log("Renegotiated again"), ssl:send(Socket, "Hello world"), diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl new file mode 100644 index 0000000000..46cd644e4d --- /dev/null +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -0,0 +1,168 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_sni_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [no_sni_header, sni_match, sni_no_match] ++ [no_sni_header_fun, sni_match_fun, sni_no_match_fun]. + +init_per_suite(Config0) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config0) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +no_sni_header(Config) -> + run_handshake(Config, undefined, undefined, "server"). + +no_sni_header_fun(Config) -> + run_sni_fun_handshake(Config, undefined, undefined, "server"). + +sni_match(Config) -> + run_handshake(Config, "a.server", "a.server", "a.server"). + +sni_match_fun(Config) -> + run_sni_fun_handshake(Config, "a.server", "a.server", "a.server"). + +sni_no_match(Config) -> + run_handshake(Config, "c.server", undefined, "server"). + +sni_no_match_fun(Config) -> + run_sni_fun_handshake(Config, "c.server", undefined, "server"). + + +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- + + +ssl_recv(SSLSocket, Expect) -> + ssl_recv(SSLSocket, "", Expect). + +ssl_recv(SSLSocket, CurrentData, ExpectedData) -> + receive + {ssl, SSLSocket, Data} -> + NeweData = CurrentData ++ Data, + case NeweData of + ExpectedData -> + ok; + _ -> + ssl_recv(SSLSocket, NeweData, ExpectedData) + end; + Other -> + ct:fail({unexpected_message, Other}) + after 4000 -> + ct:fail({timeout, CurrentData, ExpectedData}) + end. + + + +send_and_hostname(SSLSocket) -> + ssl:send(SSLSocket, "OK"), + {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), + Hostname. + +rdnPart([[#'AttributeTypeAndValue'{type=Type, value=Value} | _] | _], Type) -> Value; +rdnPart([_ | Tail], Type) -> rdnPart(Tail, Type); +rdnPart([], _) -> unknown. + +rdn_to_string({utf8String, Binary}) -> + erlang:binary_to_list(Binary); +rdn_to_string({printableString, String}) -> + String. + +recv_and_certificate(SSLSocket) -> + ssl_recv(SSLSocket, "OK"), + {ok, PeerCert} = ssl:peercert(SSLSocket), + #'OTPCertificate'{tbsCertificate = #'OTPTBSCertificate'{subject = {rdnSequence, Subject}}} = public_key:pkix_decode_cert(PeerCert, otp), + ct:log("Subject of certificate received from server: ~p", [Subject]), + rdn_to_string(rdnPart(Subject, ?'id-at-commonName')). + +run_sni_fun_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), + [{sni_hosts, ServerSNIConf}] = ?config(sni_server_opts, Config), + SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, + ServerOptions = ?config(server_opts, Config) ++ [{sni_fun, SNIFun}], + ClientOptions = + case SNIHostname of + undefined -> + ?config(client_opts, Config); + _ -> + [{server_name_indication, SNIHostname}] ++ ?config(client_opts, Config) + end, + ct:log("Options: ~p", [[ServerOptions, ClientOptions]]), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, + {options, ServerOptions}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, {from, self()}, + {mfa, {?MODULE, recv_and_certificate, []}}, + {options, ClientOptions}]), + ssl_test_lib:check_result(Server, ExpectedSNIHostname, Client, ExpectedCN). + + +run_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), + ServerOptions = ?config(sni_server_opts, Config) ++ ?config(server_opts, Config), + ClientOptions = + case SNIHostname of + undefined -> + ?config(client_opts, Config); + _ -> + [{server_name_indication, SNIHostname}] ++ ?config(client_opts, Config) + end, + ct:log("Options: ~p", [[ServerOptions, ClientOptions]]), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, + {options, ServerOptions}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, {from, self()}, + {mfa, {?MODULE, recv_and_certificate, []}}, + {options, ClientOptions}]), + ssl_test_lib:check_result(Server, ExpectedSNIHostname, Client, ExpectedCN). diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index d19e3b7fdb..8b98e6f16b 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -354,6 +354,11 @@ cert_options(Config) -> BadKeyFile = filename:join([?config(priv_dir, Config), "badkey.pem"]), PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + + SNIServerACertFile = filename:join([?config(priv_dir, Config), "a.server", "cert.pem"]), + SNIServerAKeyFile = filename:join([?config(priv_dir, Config), "a.server", "key.pem"]), + SNIServerBCertFile = filename:join([?config(priv_dir, Config), "b.server", "cert.pem"]), + SNIServerBKeyFile = filename:join([?config(priv_dir, Config), "b.server", "key.pem"]), [{client_opts, [{ssl_imp, new},{reuseaddr, true}]}, {client_verification_opts, [{cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, @@ -414,7 +419,17 @@ cert_options(Config) -> {server_bad_cert, [{ssl_imp, new},{cacertfile, ServerCaCertFile}, {certfile, BadCertFile}, {keyfile, ServerKeyFile}]}, {server_bad_key, [{ssl_imp, new},{cacertfile, ServerCaCertFile}, - {certfile, ServerCertFile}, {keyfile, BadKeyFile}]} + {certfile, ServerCertFile}, {keyfile, BadKeyFile}]}, + {sni_server_opts, [{sni_hosts, [ + {"a.server", [ + {certfile, SNIServerACertFile}, + {keyfile, SNIServerAKeyFile} + ]}, + {"b.server", [ + {certfile, SNIServerBCertFile}, + {keyfile, SNIServerBKeyFile} + ]} + ]}]} | Config]. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 94426a3061..0413415e49 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -50,9 +50,9 @@ all() -> groups() -> [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, - {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, - {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'sslv3', [], all_versions_tests()}]. basic_tests() -> @@ -101,6 +101,14 @@ npn_tests() -> erlang_client_openssl_server_npn_only_client, erlang_client_openssl_server_npn_only_server]. +sni_server_tests() -> + [erlang_server_openssl_client_sni_match, + erlang_server_openssl_client_sni_match_fun, + erlang_server_openssl_client_sni_no_match, + erlang_server_openssl_client_sni_no_match_fun, + erlang_server_openssl_client_sni_no_header, + erlang_server_openssl_client_sni_no_header_fun]. + init_per_suite(Config0) -> Dog = ct:timetrap(?LONG_TIMEOUT *2), @@ -222,6 +230,15 @@ special_init(TestCase, Config) check_openssl_npn_support(Config) end; +special_init(TestCase, Config) + when TestCase == erlang_server_openssl_client_sni_match; + TestCase == erlang_server_openssl_client_sni_no_match; + TestCase == erlang_server_openssl_client_sni_no_header; + TestCase == erlang_server_openssl_client_sni_match_fun; + TestCase == erlang_server_openssl_client_sni_no_match_fun; + TestCase == erlang_server_openssl_client_sni_no_header_fun -> + check_openssl_sni_support(Config); + special_init(_, Config) -> Config. @@ -1181,6 +1198,25 @@ erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok) end), ok. +%-------------------------------------------------------------------------- +erlang_server_openssl_client_sni_no_header(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server"). + +erlang_server_openssl_client_sni_no_header_fun(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server"). + +erlang_server_openssl_client_sni_match(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "a.server"). + +erlang_server_openssl_client_sni_match_fun(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "a.server"). + +erlang_server_openssl_client_sni_no_match(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server"). + +erlang_server_openssl_client_sni_no_match_fun(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server"). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -1207,6 +1243,89 @@ run_suites(Ciphers, Version, Config, Type) -> ct:fail(cipher_suite_failed_see_test_case_log) end. +client_read_check([], _NewData) -> ok; +client_read_check([Hd | T], NewData) -> + case binary:match(NewData, list_to_binary(Hd)) of + nomatch -> + nomatch; + _ -> + client_read_check(T, NewData) + end. +client_read_bulk(Port, DataExpected, DataReceived) -> + receive + {Port, {data, TheData}} -> + Data = list_to_binary(TheData), + NewData = <<DataReceived/binary, Data/binary>>, + ct:log("New Data: ~p", [NewData]), + case client_read_check(DataExpected, NewData) of + ok -> + ok; + _ -> + client_read_bulk(Port, DataExpected, NewData) + end; + _ -> + ct:fail("unexpected_message") + after 4000 -> + ct:fail("timeout") + end. +client_read_bulk(Port, DataExpected) -> + client_read_bulk(Port, DataExpected, <<"">>). + +send_and_hostname(SSLSocket) -> + ssl:send(SSLSocket, "OK"), + {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), + Hostname. + +erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), + ServerOptions = ?config(sni_server_opts, Config) ++ ?config(server_opts, Config), + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, + {options, ServerOptions}]), + Port = ssl_test_lib:inet_port(Server), + ClientCommand = case SNIHostname of + undefined -> + "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + _ -> + "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname + end, + ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), + ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ssl_test_lib:check_result(Server, ExpectedSNIHostname), + ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"], + ok = client_read_bulk(ClientPort, ExpectedClientOutput), + ssl_test_lib:close_port(ClientPort), + ssl_test_lib:close(Server), + ok. + + +erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), + [{sni_hosts, ServerSNIConf}] = ?config(sni_server_opts, Config), + SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, + ServerOptions = ?config(server_opts, Config) ++ [{sni_fun, SNIFun}], + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, + {options, ServerOptions}]), + Port = ssl_test_lib:inet_port(Server), + ClientCommand = case SNIHostname of + undefined -> + "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + _ -> + "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname + end, + ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), + ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ssl_test_lib:check_result(Server, ExpectedSNIHostname), + ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"], + ok = client_read_bulk(ClientPort, ExpectedClientOutput), + ssl_test_lib:close_port(ClientPort), + ssl_test_lib:close(Server), + ok. + + cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> process_flag(trap_exit, true), ct:log("Testing CipherSuite ~p~n", [CipherSuite]), @@ -1588,6 +1707,14 @@ server_sent_garbage(Socket) -> end. +check_openssl_sni_support(Config) -> + HelpText = os:cmd("openssl s_client --help"), + case string:str(HelpText, "-servername") of + 0 -> + {skip, "Current openssl doesn't support SNI"}; + _ -> + Config + end. check_openssl_npn_support(Config) -> HelpText = os:cmd("openssl s_client --help"), diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index ce1e19a2a4..a4a2ed9931 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -82,6 +82,7 @@ XML_REF3_FILES = \ proplists.xml \ qlc.xml \ queue.xml \ + rand.xml \ random.xml \ re.xml \ sets.xml \ diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index b49fa6ad67..b43d4786ae 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -232,6 +232,14 @@ compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_w </desc> </func> <func> + <name name="uptime" arity="0"/> + <fsummary>Print node uptime</fsummary> + <desc> + <p>Prints the node uptime (as given by + <c>erlang:statistics(wall_clock)</c>), in human-readable form.</p> + </desc> + </func> + <func> <name>xm(ModSpec) -> void()</name> <fsummary>Cross reference check a module</fsummary> <type> diff --git a/lib/stdlib/doc/src/gb_sets.xml b/lib/stdlib/doc/src/gb_sets.xml index ea96c14472..405bae5698 100644 --- a/lib/stdlib/doc/src/gb_sets.xml +++ b/lib/stdlib/doc/src/gb_sets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2001</year><year>2014</year> + <year>2001</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -306,6 +306,17 @@ </desc> </func> <func> + <name name="iterator_from" arity="2"/> + <fsummary>Return an iterator for a set starting from a specified element</fsummary> + <desc> + <p>Returns an iterator that can be used for traversing the + entries of <c><anno>Set</anno></c>; see <c>next/1</c>. + The difference as compared to the iterator returned by + <c>iterator/1</c> is that the first element greater than + or equal to <c><anno>Element</anno></c> is returned.</p> + </desc> + </func> + <func> <name name="largest" arity="1"/> <fsummary>Return largest element</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index b2f237e1d7..82167e1083 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2001</year><year>2014</year> + <year>2001</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -183,6 +183,17 @@ </desc> </func> <func> + <name name="iterator_from" arity="2"/> + <fsummary>Return an iterator for a tree starting from specified key</fsummary> + <desc> + <p>Returns an iterator that can be used for traversing the + entries of <c><anno>Tree</anno></c>; see <c>next/1</c>. + The difference as compared to the iterator returned by + <c>iterator/1</c> is that the first key greater than + or equal to <c><anno>Key</anno></c> is returned.</p> + </desc> + </func> + <func> <name name="keys" arity="1"/> <fsummary>Return a list of the keys in a tree</fsummary> <desc> diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index ee3c51c62c..dcc08d008b 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -176,7 +176,7 @@ filtermap(Fun, List1) -> false -> Acc; true -> [Elem|Acc]; {true,Value} -> [Value|Acc] - end, + end end, [], List1).</code> <p>Example:</p> <pre> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 59c26d9896..7345a9357a 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -33,6 +33,28 @@ <funcs> <func> + <name name="filter" arity="2"/> + <fsummary>Choose pairs which satisfy a predicate</fsummary> + <desc> + <p> + Returns a map <c><anno>Map2</anno></c> for which predicate + <c><anno>Pred</anno></c> holds true in <c><anno>Map1</anno></c>. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if + <c><anno>Map1</anno></c> is not a map or with <c>badarg</c> if + <c><anno>Pred</anno></c> is not a function of arity 2. + </p> + <p>Example:</p> + <code type="none"> +> M = #{a => 2, b => 3, c=> 4, "a" => 1, "b" => 2, "c" => 4}, + Pred = fun(K,V) -> is_atom(K) andalso (V rem 2) =:= 0 end, + maps:filter(Pred,M). +#{a => 2,c => 4} </code> + </desc> + </func> + + <func> <name name="find" arity="2"/> <fsummary></fsummary> <desc> @@ -339,7 +361,7 @@ false</code> <fsummary></fsummary> <desc> <p> - Returns a complete list of values, in arbitrary order, contained in map <c>M</c>. + Returns a complete list of values, in arbitrary order, contained in map <c>Map</c>. </p> <p> The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml new file mode 100644 index 0000000000..178afda5a0 --- /dev/null +++ b/lib/stdlib/doc/src/rand.xml @@ -0,0 +1,246 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>rand</title> + <prepared></prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date></date> + <rev>A</rev> + <file>rand.xml</file> + </header> + <module>rand</module> + <modulesummary>Pseudo random number generation</modulesummary> + <description> + <p>Random number generator.</p> + + <p>The module contains several different algorithms and can be + extended with more in the future. The current uniform + distribution algorithms uses the + <url href="http://xorshift.di.unimi.it"> + scrambled Xorshift algorithms by Sebastiano Vigna</url> and the + normal distribution algorithm uses the + <url href="http://www.jstatsoft.org/v05/i08"> + Ziggurat Method by Marsaglia and Tsang</url>. + </p> + + <p>The implemented algorithms are:</p> + <taglist> + <tag><c>exsplus</c></tag> <item>Xorshift116+, 58 bits precision and period of 2^116-1.</item> + <tag><c>exs64</c></tag> <item>Xorshift64*, 64 bits precision and a period of 2^64-1.</item> + <tag><c>exs1024</c></tag> <item>Xorshift1024*, 64 bits precision and a period of 2^1024-1.</item> + </taglist> + + <p>The current default algorithm is <c>exsplus</c>. The default + may change in future. If a specific algorithm is required make + sure to always use <seealso marker="#seed-1">seed/1</seealso> + to initialize the state. + </p> + + <p>Every time a random number is requested, a state is used to + calculate it and a new state produced. The state can either be + implicit or it can be an explicit argument and return value. + </p> + + <p>The functions with implicit state use the process dictionary + variable <c>rand_seed</c> to remember the current state.</p> + + <p>If a process calls <seealso marker="#uniform-0">uniform/0</seealso> or + <seealso marker="#uniform-1">uniform/1</seealso> without + setting a seed first, <seealso marker="#seed-1">seed/1</seealso> + is called automatically with the default algorithm and creates a + non-constant seed.</p> + + <p>The functions with explicit state never use the process + dictionary.</p> + + <p>Examples:</p> + <pre> + %% Simple usage. Creates and seeds the default algorithm + %% with a non-constant seed if not already done. + R0 = rand:uniform(), + R1 = rand:uniform(), + + %% Use a given algorithm. + _ = rand:seed(exs1024), + R2 = rand:uniform(), + + %% Use a given algorithm with a constant seed. + _ = rand:seed(exs1024, {123, 123534, 345345}), + R3 = rand:uniform(), + + %% Use the functional api with non-constant seed. + S0 = rand:seed_s(exsplus), + {R4, S1} = rand:uniform_s(S0), + + %% Create a standard normal deviate. + {SND0, S2} = rand:normal_s(S1), + </pre> + + <note><p>This random number generator is not cryptographically + strong. If a strong cryptographic random number generator is + needed, use one of functions in the + <seealso marker="crypto:crypto">crypto</seealso> + module, for example <c>crypto:rand_bytes/1</c>.</p></note> + </description> + <datatypes> + <datatype> + <name name="alg"/> + </datatype> + + <datatype> + <name name="state"/> + <desc><p>Algorithm dependent state.</p></desc> + </datatype> + + <datatype> + <name name="export_state"/> + <desc><p>Algorithm dependent state which can be printed or saved to file.</p></desc> + </datatype> + </datatypes> + + <funcs> + <func> + <name name="seed" arity="1"/> + <fsummary>Seed random number generator</fsummary> + <desc> + <marker id="seed-1"/> + <p>Seeds random number generation with the given algorithm and time dependent + data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p>Otherwise recreates the exported seed in the process + dictionary, and returns the state. + <em>See also:</em> <seealso marker="#export_seed-0">export_seed/0</seealso>.</p> + </desc> + </func> + <func> + <name name="seed_s" arity="1"/> + <fsummary>Seed random number generator</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and time dependent + data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p>Otherwise recreates the exported seed and returns the state. + <em>See also:</em> <seealso marker="#export_seed-0">export_seed/0</seealso>.</p> + </desc> + </func> + <func> + <name name="seed" arity="2"/> + <fsummary>Seed the random number generation</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and + integers in the process dictionary and returns + the state.</p> + </desc> + </func> + <func> + <name name="seed_s" arity="2"/> + <fsummary>Seed the random number generation</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and + integers and returns the state.</p> + </desc> + </func> + + <func> + <name name="export_seed" arity="0"/> + <fsummary>Export the random number generation state</fsummary> + <desc><marker id="export_seed-0"/> + <p>Returns the random number state in an external format. + To be used with <seealso marker="#seed-1">seed/1</seealso>.</p> + </desc> + </func> + + <func> + <name name="export_seed_s" arity="1"/> + <fsummary>Export the random number generation state</fsummary> + <desc><marker id="export_seed_s-1"/> + <p>Returns the random number generator state in an external format. + To be used with <seealso marker="#seed-1">seed/1</seealso>.</p> + </desc> + </func> + + <func> + <name name="uniform" arity="0"/> + <fsummary>Return a random float</fsummary> + <desc> + <marker id="uniform-0"/> + <p>Returns a random float uniformly distributed in the value + range <c>0.0 < <anno>X</anno> < 1.0 </c> and + updates the state in the process dictionary.</p> + </desc> + </func> + <func> + <name name="uniform_s" arity="1"/> + <fsummary>Return a random float</fsummary> + <desc> + <p>Given a state, <c>uniform_s/1</c> returns a random float + uniformly distributed in the value range <c>0.0 < + <anno>X</anno> < 1.0</c> and a new state.</p> + </desc> + </func> + + <func> + <name name="uniform" arity="1"/> + <fsummary>Return a random integer</fsummary> + <desc> + <marker id="uniform-1"/> + <p>Given an integer <c><anno>N</anno> >= 1</c>, + <c>uniform/1</c> returns a random integer uniformly + distributed in the value range + <c>1 <= <anno>X</anno> <= <anno>N</anno></c> and + updates the state in the process dictionary.</p> + </desc> + </func> + <func> + <name name="uniform_s" arity="2"/> + <fsummary>Return a random integer</fsummary> + <desc> + <p>Given an integer <c><anno>N</anno> >= 1</c> and a state, + <c>uniform_s/2</c> returns a random integer uniformly + distributed in the value range <c>1 <= <anno>X</anno> <= + <anno>N</anno></c> and a new state.</p> + </desc> + </func> + + <func> + <name name="normal" arity="0"/> + <fsummary>Return a standard normal distributed random float</fsummary> + <desc> + <p>Returns a standard normal deviate float (that is, the mean + is 0 and the standard deviation is 1) and updates the state in + the process dictionary.</p> + </desc> + </func> + <func> + <name name="normal_s" arity="1"/> + <fsummary>Return a standard normal distributed random float</fsummary> + <desc> + <p>Given a state, <c>normal_s/1</c> returns a standard normal + deviate float (that is, the mean is 0 and the standard + deviation is 1) and a new state.</p> + </desc> + </func> + + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index 2cc621ffc3..e475cda23d 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -48,6 +48,9 @@ <p>It should be noted that this random number generator is not cryptographically strong. If a strong cryptographic random number generator is needed for example <c>crypto:rand_bytes/1</c> could be used instead.</p> + <note><p>The new and improved <seealso + marker="stdlib:rand">rand</seealso> module should be used + instead of this module.</p></note> </description> <datatypes> <datatype> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 94c1fb55c2..eee4a68ca1 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -79,6 +79,7 @@ <xi:include href="proplists.xml"/> <xi:include href="qlc.xml"/> <xi:include href="queue.xml"/> + <xi:include href="rand.xml"/> <xi:include href="random.xml"/> <xi:include href="re.xml"/> <xi:include href="sets.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 6ae0154800..0418bf7b22 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -45,6 +45,7 @@ <xi:include href="../specs/specs_proplists.xml"/> <xi:include href="../specs/specs_qlc.xml"/> <xi:include href="../specs/specs_queue.xml"/> + <xi:include href="../specs/specs_rand.xml"/> <xi:include href="../specs/specs_random.xml"/> <xi:include href="../specs/specs_re.xml"/> <xi:include href="../specs/specs_sets.xml"/> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 85b858febd..55bda60da5 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -105,6 +105,7 @@ MODULES= \ qlc \ qlc_pt \ queue \ + rand \ random \ sets \ shell \ diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 9860adf04d..d5b24d3c32 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -27,7 +27,7 @@ lc_batch/0, lc_batch/1, i/3,pid/3,m/0,m/1, bt/1, q/0, - erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, + erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, uptime/0, nregs/0,pwd/0,ls/0,ls/1,cd/1,memory/1,memory/0, xm/1]). -export([display_info/1]). @@ -65,6 +65,7 @@ help() -> "q() -- quit - shorthand for init:stop()\n" "regs() -- information about registered processes\n" "nregs() -- information about all registered processes\n" + "uptime() -- print node uptime\n" "xm(M) -- cross reference check a module\n" "y(File) -- generate a Yecc parser\n">>). @@ -774,6 +775,26 @@ memory() -> erlang:memory(). memory(TypeSpec) -> erlang:memory(TypeSpec). %% +%% uptime/0 +%% + +-spec uptime() -> 'ok'. + +uptime() -> + io:format("~s~n", [uptime(get_uptime())]). + +uptime({D, {H, M, S}}) -> + lists:flatten( + [[ io_lib:format("~p days, ", [D]) || D > 0 ], + [ io_lib:format("~p hours, ", [H]) || D+H > 0 ], + [ io_lib:format("~p minutes and ", [M]) || D+H+M > 0 ], + io_lib:format("~p seconds", [S])]). + +get_uptime() -> + {UpTime, _} = erlang:statistics(wall_clock), + calendar:seconds_to_daystime(UpTime div 1000). + +%% %% Cross Reference Check %% %%-spec xm(module() | file:filename()) -> xref:m/1 return diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index 0c21271529..1f8caa88a4 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -36,7 +36,7 @@ -export([get_short_path/3, get_short_cycle/2]). --export_type([graph/0, d_type/0, vertex/0, edge/0]). +-export_type([graph/0, d_type/0, vertex/0, edge/0, label/0]). -record(digraph, {vtab = notable :: ets:tab(), etab = notable :: ets:tab(), diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 632af17e2a..68bd4f71cc 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -648,7 +648,7 @@ split(Name0) -> unix_splitb(Name) -> L = binary:split(Name,[<<"/">>],[global]), LL = case L of - [<<>>|Rest] -> + [<<>>|Rest] when Rest =/= [] -> [<<"/">>|Rest]; _ -> L diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl index 393fb07229..d3fbd542f7 100644 --- a/lib/stdlib/src/gb_sets.erl +++ b/lib/stdlib/src/gb_sets.erl @@ -137,6 +137,10 @@ %% approach is that it does not require the complete list of all %% elements to be built in memory at one time. %% +%% - iterator_from(X, S): returns an iterator that can be used for +%% traversing the elements of set S greater than or equal to X; +%% see `next'. +%% %% - next(T): returns {X, T1} where X is the smallest element referred %% to by the iterator T, and T1 is the new iterator to be used for %% traversing the remaining elements, or the atom `none' if no @@ -157,8 +161,8 @@ insert/2, add/2, delete/2, delete_any/2, balance/1, union/2, union/1, intersection/2, intersection/1, is_disjoint/2, difference/2, is_subset/2, to_list/1, from_list/1, from_ordset/1, smallest/1, - largest/1, take_smallest/1, take_largest/1, iterator/1, next/1, - filter/2, fold/3, is_set/1]). + largest/1, take_smallest/1, take_largest/1, iterator/1, + iterator_from/2, next/1, filter/2, fold/3, is_set/1]). %% `sets' compatibility aliases: @@ -500,6 +504,22 @@ iterator({_, L, _} = T, As) -> iterator(nil, As) -> As. +-spec iterator_from(Element, Set) -> Iter when + Set :: set(Element), + Iter :: iter(Element). + +iterator_from(S, {_, T}) -> + iterator_from(S, T, []). + +iterator_from(S, {K, _, T}, As) when K < S -> + iterator_from(S, T, As); +iterator_from(_, {_, nil, _} = T, As) -> + [T | As]; +iterator_from(S, {_, L, _} = T, As) -> + iterator_from(S, L, [T | As]); +iterator_from(_, nil, As) -> + As. + -spec next(Iter1) -> {Element, Iter2} | 'none' when Iter1 :: iter(Element), Iter2 :: iter(Element). diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 7069b61873..259e8f718b 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -102,6 +102,10 @@ %% approach is that it does not require the complete list of all %% elements to be built in memory at one time. %% +%% - iterator_from(K, T): returns an iterator that can be used for +%% traversing the entries of tree T with key greater than or +%% equal to K; see `next'. +%% %% - next(S): returns {X, V, S1} where X is the smallest key referred to %% by the iterator S, and S1 is the new iterator to be used for %% traversing the remaining entries, or the atom `none' if no entries @@ -117,7 +121,7 @@ update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, smallest/1, largest/1, take_smallest/1, take_largest/1, - iterator/1, next/1, map/2]). + iterator/1, iterator_from/2, next/1, map/2]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -529,6 +533,29 @@ iterator({_, _, L, _} = T, As) -> iterator(nil, As) -> As. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec iterator_from(Key, Tree) -> Iter when + Tree :: tree(Key, Value), + Iter :: iter(Key, Value). + +iterator_from(S, {_, T}) -> + iterator_1_from(S, T). + +iterator_1_from(S, T) -> + iterator_from(S, T, []). + +iterator_from(S, {K, _, _, T}, As) when K < S -> + iterator_from(S, T, As); +iterator_from(_, {_, _, nil, _} = T, As) -> + [T | As]; +iterator_from(S, {_, _, L, _} = T, As) -> + iterator_from(S, L, [T | As]); +iterator_from(_, nil, As) -> + As. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + -spec next(Iter1) -> 'none' | {Key, Value, Iter2} when Iter1 :: iter(Key, Value), Iter2 :: iter(Key, Value). diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 3877c150ec..533ff08726 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -19,7 +19,8 @@ -module(maps). --export([get/3,fold/3, map/2, size/1, +-export([get/3,filter/2,fold/3, map/2, + size/1, without/2, with/2]). @@ -145,6 +146,19 @@ get(Key,Map,Default) -> erlang:error({badmap,Map},[Key,Map,Default]). +-spec filter(Pred,Map1) -> Map2 when + Pred :: fun((Key, Value) -> boolean()), + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +filter(Pred,Map) when is_function(Pred,2), is_map(Map) -> + maps:from_list([{K,V}||{K,V}<-maps:to_list(Map),Pred(K,V)]); +filter(Pred,Map) -> + erlang:error(error_type(Map),[Pred,Map]). + + -spec fold(Fun,Init,Map) -> Acc when Fun :: fun((K, V, AccIn) -> AccOut), Init :: term(), @@ -169,10 +183,7 @@ fold(Fun,Init,Map) -> V2 :: term(). map(Fun,Map) when is_function(Fun, 2), is_map(Map) -> - maps:from_list(lists:map(fun - ({K,V}) -> - {K,Fun(K,V)} - end,maps:to_list(Map))); + maps:from_list([{K,Fun(K,V)}||{K,V}<-maps:to_list(Map)]); map(Fun,Map) -> erlang:error(error_type(Map),[Fun,Map]). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 24721da187..0340015c35 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -631,6 +631,9 @@ obsolete_1(erl_lint, modify_line, 2) -> obsolete_1(ssl, negotiated_next_protocol, 1) -> {deprecated,{ssl,negotiated_protocol,1}}; +obsolete_1(ssl, connection_info, 1) -> + {deprecated, "deprecated; use connection_information/[1,2] instead"}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl new file mode 100644 index 0000000000..6a805eb69e --- /dev/null +++ b/lib/stdlib/src/rand.erl @@ -0,0 +1,591 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% ===================================================================== +%% Multiple PRNG module for Erlang/OTP +%% Copyright (c) 2015 Kenji Rikitake +%% ===================================================================== + +-module(rand). + +-export([seed_s/1, seed_s/2, seed/1, seed/2, + export_seed/0, export_seed_s/1, + uniform/0, uniform/1, uniform_s/1, uniform_s/2, + normal/0, normal_s/1 + ]). + +-compile({inline, [exs64_next/1, exsplus_next/1, + exs1024_next/1, exs1024_calc/2, + get_52/1, normal_kiwi/1]}). + +-define(DEFAULT_ALG_HANDLER, exsplus). +-define(SEED_DICT, rand_seed). + +%% ===================================================================== +%% Types +%% ===================================================================== + +%% This depends on the algorithm handler function +-type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). +%% This is the algorithm handler function within this module +-type alg_handler() :: #{type => alg(), + max => integer(), + next => fun(), + uniform => fun(), + uniform_n => fun()}. + +%% Internal state +-opaque state() :: {alg_handler(), alg_seed()}. +-type alg() :: exs64 | exsplus | exs1024. +-opaque export_state() :: {alg(), alg_seed()}. +-export_type([alg/0, state/0, export_state/0]). + +%% ===================================================================== +%% API +%% ===================================================================== + +%% Return algorithm and seed so that RNG state can be recreated with seed/1 +-spec export_seed() -> undefined | export_state(). +export_seed() -> + case seed_get() of + {#{type:=Alg}, Seed} -> {Alg, Seed}; + _ -> undefined + end. + +-spec export_seed_s(state()) -> export_state(). +export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. + +%% seed(Alg) seeds RNG with runtime dependent values +%% and return the NEW state + +%% seed({Alg,Seed}) setup RNG with a previously exported seed +%% and return the NEW state + +-spec seed(AlgOrExpState::alg() | export_state()) -> state(). +seed(Alg) -> + R = seed_s(Alg), + _ = seed_put(R), + R. + +-spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). +seed_s(Alg) when is_atom(Alg) -> + seed_s(Alg, {erlang:phash2([{node(),self()}]), + erlang:system_time(), + erlang:unique_integer()}); +seed_s({Alg0, Seed}) -> + {Alg,_SeedFun} = mk_alg(Alg0), + {Alg, Seed}. + +%% seed/2: seeds RNG with the algorithm and given values +%% and returns the NEW state. + +-spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed(Alg0, S0) -> + State = seed_s(Alg0, S0), + _ = seed_put(State), + State. + +-spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed_s(Alg0, S0 = {_, _, _}) -> + {Alg, Seed} = mk_alg(Alg0), + AS = Seed(S0), + {Alg, AS}. + +%%% uniform/0, uniform/1, uniform_s/1, uniform_s/2 are all +%%% uniformly distributed random numbers. + +%% uniform/0: returns a random float X where 0.0 < X < 1.0, +%% updating the state in the process dictionary. + +-spec uniform() -> X::float(). +uniform() -> + {X, Seed} = uniform_s(seed_get()), + _ = seed_put(Seed), + X. + +%% uniform/1: given an integer N >= 1, +%% uniform/1 returns a random integer X where 1 =< X =< N, +%% updating the state in the process dictionary. + +-spec uniform(N :: pos_integer()) -> X::pos_integer(). +uniform(N) -> + {X, Seed} = uniform_s(N, seed_get()), + _ = seed_put(Seed), + X. + +%% uniform_s/1: given a state, uniform_s/1 +%% returns a random float X where 0.0 < X < 1.0, +%% and a new state. + +-spec uniform_s(state()) -> {X::float(), NewS :: state()}. +uniform_s(State = {#{uniform:=Uniform}, _}) -> + Uniform(State). + +%% uniform_s/2: given an integer N >= 1 and a state, uniform_s/2 +%% uniform_s/2 returns a random integer X where 1 =< X =< N, +%% and a new state. + +-spec uniform_s(N::pos_integer(), state()) -> {X::pos_integer(), NewS::state()}. +uniform_s(N, State = {#{uniform_n:=Uniform, max:=Max}, _}) + when 0 < N, N =< Max -> + Uniform(N, State); +uniform_s(N, State0 = {#{uniform:=Uniform}, _}) + when is_integer(N), 0 < N -> + {F, State} = Uniform(State0), + {trunc(F * N) + 1, State}. + +%% normal/0: returns a random float with standard normal distribution +%% updating the state in the process dictionary. + +-spec normal() -> float(). +normal() -> + {X, Seed} = normal_s(seed_get()), + _ = seed_put(Seed), + X. + +%% normal_s/1: returns a random float with standard normal distribution +%% The Ziggurat Method for generating random variables - Marsaglia and Tsang +%% Paper and reference code: http://www.jstatsoft.org/v05/i08/ + +-spec normal_s(state()) -> {float(), NewS :: state()}. +normal_s(State0) -> + {Sign, R, State} = get_52(State0), + Idx = R band 16#FF, + Idx1 = Idx+1, + {Ki, Wi} = normal_kiwi(Idx1), + X = R * Wi, + case R < Ki of + %% Fast path 95% of the time + true when Sign =:= 0 -> {X, State}; + true -> {-X, State}; + %% Slow path + false when Sign =:= 0 -> normal_s(Idx, Sign, X, State); + false -> normal_s(Idx, Sign, -X, State) + end. + +%% ===================================================================== +%% Internal functions + +-define(UINT21MASK, 16#00000000001fffff). +-define(UINT32MASK, 16#00000000ffffffff). +-define(UINT33MASK, 16#00000001ffffffff). +-define(UINT39MASK, 16#0000007fffffffff). +-define(UINT58MASK, 16#03ffffffffffffff). +-define(UINT64MASK, 16#ffffffffffffffff). + +-type uint64() :: 0..16#ffffffffffffffff. +-type uint58() :: 0..16#03ffffffffffffff. + +-spec seed_put(state()) -> undefined | state(). +seed_put(Seed) -> + put(?SEED_DICT, Seed). + +seed_get() -> + case get(?SEED_DICT) of + undefined -> seed(?DEFAULT_ALG_HANDLER); + Old -> Old % no type checking here + end. + +%% Setup alg record +mk_alg(exs64) -> + {#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1, + uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2}, + fun exs64_seed/1}; +mk_alg(exsplus) -> + {#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1, + uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2}, + fun exsplus_seed/1}; +mk_alg(exs1024) -> + {#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1, + uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2}, + fun exs1024_seed/1}. + +%% ===================================================================== +%% exs64 PRNG: Xorshift64* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs64_state() :: uint64(). + +exs64_seed({A1, A2, A3}) -> + {V1, _} = exs64_next(((A1 band ?UINT32MASK) * 4294967197 + 1)), + {V2, _} = exs64_next(((A2 band ?UINT32MASK) * 4294967231 + 1)), + {V3, _} = exs64_next(((A3 band ?UINT32MASK) * 4294967279 + 1)), + ((V1 * V2 * V3) rem (?UINT64MASK - 1)) + 1. + +%% Advance xorshift64* state for one step and generate 64bit unsigned integer +-spec exs64_next(exs64_state()) -> {uint64(), exs64_state()}. +exs64_next(R) -> + R1 = R bxor (R bsr 12), + R2 = R1 bxor ((R1 band ?UINT39MASK) bsl 25), + R3 = R2 bxor (R2 bsr 27), + {(R3 * 2685821657736338717) band ?UINT64MASK, R3}. + +exs64_uniform({Alg, R0}) -> + {V, R1} = exs64_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs64_uniform(Max, {Alg, R}) -> + {V, R1} = exs64_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exsplus PRNG: Xorshift116+ +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% 58 bits fits into an immediate on 64bits erlang and is thus much faster. +%% Modification of the original Xorshift128+ algorithm to 116 +%% by Sebastiano Vigna, a lot of thanks for his help and work. +%% ===================================================================== +-type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). + +exsplus_seed({A1, A2, A3}) -> + {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| + (((A2 * 4294967231) + 1) band ?UINT58MASK)]), + {_, R2} = exsplus_next([(((A3 * 4294967279) + 1) band ?UINT58MASK)| + tl(R1)]), + R2. + +%% Advance xorshift116+ state for one step and generate 58bit unsigned integer +-spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. +exsplus_next([S1|S0]) -> + %% Note: members s0 and s1 are swapped here + S11 = (S1 bxor (S1 bsl 24)) band ?UINT58MASK, + S12 = S11 bxor S0 bxor (S11 bsr 11) bxor (S0 bsr 41), + {(S0 + S12) band ?UINT58MASK, [S0|S12]}. + +exsplus_uniform({Alg, R0}) -> + {I, R1} = exsplus_next(R0), + {I / (?UINT58MASK+1), {Alg, R1}}. + +exsplus_uniform(Max, {Alg, R}) -> + {V, R1} = exsplus_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exs1024 PRNG: Xorshift1024* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs1024_state() :: {list(uint64()), list(uint64())}. + +exs1024_seed({A1, A2, A3}) -> + B1 = (((A1 band ?UINT21MASK) + 1) * 2097131) band ?UINT21MASK, + B2 = (((A2 band ?UINT21MASK) + 1) * 2097133) band ?UINT21MASK, + B3 = (((A3 band ?UINT21MASK) + 1) * 2097143) band ?UINT21MASK, + {exs1024_gen1024((B1 bsl 43) bor (B2 bsl 22) bor (B3 bsl 1) bor 1), + []}. + +%% Generate a list of 16 64-bit element list +%% of the xorshift64* random sequence +%% from a given 64-bit seed. +%% Note: dependent on exs64_next/1 +-spec exs1024_gen1024(uint64()) -> list(uint64()). +exs1024_gen1024(R) -> + exs1024_gen1024(16, R, []). + +exs1024_gen1024(0, _, L) -> + L; +exs1024_gen1024(N, R, L) -> + {X, R2} = exs64_next(R), + exs1024_gen1024(N - 1, R2, [X|L]). + +%% Calculation of xorshift1024*. +%% exs1024_calc(S0, S1) -> {X, NS1}. +%% X: random number output +-spec exs1024_calc(uint64(), uint64()) -> {uint64(), uint64()}. +exs1024_calc(S0, S1) -> + S11 = S1 bxor ((S1 band ?UINT33MASK) bsl 31), + S12 = S11 bxor (S11 bsr 11), + S01 = S0 bxor (S0 bsr 30), + NS1 = S01 bxor S12, + {(NS1 * 1181783497276652981) band ?UINT64MASK, NS1}. + +%% Advance xorshift1024* state for one step and generate 64bit unsigned integer +-spec exs1024_next(exs1024_state()) -> {uint64(), exs1024_state()}. +exs1024_next({[S0,S1|L3], RL}) -> + {X, NS1} = exs1024_calc(S0, S1), + {X, {[NS1|L3], [S0|RL]}}; +exs1024_next({[H], RL}) -> + NL = [H|lists:reverse(RL)], + exs1024_next({NL, []}). + +exs1024_uniform({Alg, R0}) -> + {V, R1} = exs1024_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs1024_uniform(Max, {Alg, R}) -> + {V, R1} = exs1024_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% Ziggurat cont +%% ===================================================================== +-define(NOR_R, 3.6541528853610087963519472518). +-define(NOR_INV_R, 1/?NOR_R). + +%% return a {sign, Random51bits, State} +get_52({Alg=#{next:=Next}, S0}) -> + {Int,S1} = Next(S0), + {((1 bsl 51) band Int), Int band ((1 bsl 51)-1), {Alg, S1}}. + +%% Slow path +normal_s(0, Sign, X0, State0) -> + {U0, S1} = uniform_s(State0), + X = -?NOR_INV_R*math:log(U0), + {U1, S2} = uniform_s(S1), + Y = -math:log(U1), + case Y+Y > X*X of + false -> + normal_s(0, Sign, X0, S2); + true when Sign =:= 0 -> + {?NOR_R + X, S2}; + true -> + {-?NOR_R - X, S2} + end; +normal_s(Idx, _Sign, X, State0) -> + Fi2 = normal_fi(Idx+1), + {U0, S1} = uniform_s(State0), + case ((normal_fi(Idx) - Fi2)*U0 + Fi2) < math:exp(-0.5*X*X) of + true -> {X, S1}; + false -> normal_s(S1) + end. + +%% Tables for generating normal_s +%% ki is zipped with wi (slightly faster) +normal_kiwi(Indx) -> + element(Indx, + {{2104047571236786,1.736725412160263e-15}, {0,9.558660351455634e-17}, + {1693657211986787,1.2708704834810623e-16},{1919380038271141,1.4909740962495474e-16}, + {2015384402196343,1.6658733631586268e-16},{2068365869448128,1.8136120810119029e-16}, + {2101878624052573,1.9429720153135588e-16},{2124958784102998,2.0589500628482093e-16}, + {2141808670795147,2.1646860576895422e-16},{2154644611568301,2.2622940392218116e-16}, + {2164744887587275,2.353271891404589e-16},{2172897953696594,2.438723455742877e-16}, + {2179616279372365,2.5194879829274225e-16},{2185247251868649,2.5962199772528103e-16}, + {2190034623107822,2.6694407473648285e-16},{2194154434521197,2.7395729685142446e-16}, + {2197736978774660,2.8069646002484804e-16},{2200880740891961,2.871905890411393e-16}, + {2203661538010620,2.9346417484728883e-16},{2206138681109102,2.9953809336782113e-16}, + {2208359231806599,3.054303000719244e-16},{2210361007258210,3.111563633892157e-16}, + {2212174742388539,3.1672988018581815e-16},{2213825672704646,3.2216280350549905e-16}, + {2215334711002614,3.274657040793975e-16},{2216719334487595,3.326479811684171e-16}, + {2217994262139172,3.377180341735323e-16},{2219171977965032,3.4268340353119356e-16}, + {2220263139538712,3.475508873172976e-16},{2221276900117330,3.523266384600203e-16}, + {2222221164932930,3.5701624633953494e-16},{2223102796829069,3.616248057159834e-16}, + {2223927782546658,3.661569752965354e-16},{2224701368170060,3.7061702777236077e-16}, + {2225428170204312,3.75008892787478e-16},{2226112267248242,3.7933619401549554e-16}, + {2226757276105256,3.836022812967728e-16},{2227366415328399,3.8781025861250247e-16}, + {2227942558554684,3.919630085325768e-16},{2228488279492521,3.9606321366256378e-16}, + {2229005890047222,4.001133755254669e-16},{2229497472775193,4.041158312414333e-16}, + {2229964908627060,4.080727683096045e-16},{2230409900758597,4.119862377480744e-16}, + {2230833995044585,4.1585816580828064e-16},{2231238597816133,4.1969036444740733e-16}, + {2231624991250191,4.234845407152071e-16},{2231994346765928,4.272423051889976e-16}, + {2232347736722750,4.309651795716294e-16},{2232686144665934,4.346546035512876e-16}, + {2233010474325959,4.383119410085457e-16},{2233321557544881,4.4193848564470665e-16}, + {2233620161276071,4.455354660957914e-16},{2233906993781271,4.491040505882875e-16}, + {2234182710130335,4.52645351185714e-16},{2234447917093496,4.561604276690038e-16}, + {2234703177503020,4.596502910884941e-16},{2234949014150181,4.631159070208165e-16}, + {2235185913274316,4.665581985600875e-16},{2235414327692884,4.699780490694195e-16}, + {2235634679614920,4.733763047158324e-16},{2235847363174595,4.767537768090853e-16}, + {2236052746716837,4.8011124396270155e-16},{2236251174862869,4.834494540935008e-16}, + {2236442970379967,4.867691262742209e-16},{2236628435876762,4.900709524522994e-16}, + {2236807855342765,4.933555990465414e-16},{2236981495548562,4.966237084322178e-16}, + {2237149607321147,4.998759003240909e-16},{2237312426707209,5.031127730659319e-16}, + {2237470176035652,5.0633490483427195e-16},{2237623064889403,5.095428547633892e-16}, + {2237771290995388,5.127371639978797e-16},{2237915041040597,5.159183566785736e-16}, + {2238054491421305,5.190869408670343e-16},{2238189808931712,5.222434094134042e-16}, + {2238321151397660,5.253882407719454e-16},{2238448668260432,5.285218997682382e-16}, + {2238572501115169,5.316448383216618e-16},{2238692784207942,5.34757496126473e-16}, + {2238809644895133,5.378603012945235e-16},{2238923204068402,5.409536709623993e-16}, + {2239033576548190,5.440380118655467e-16},{2239140871448443,5.471137208817361e-16}, + {2239245192514958,5.501811855460336e-16},{2239346638439541,5.532407845392784e-16}, + {2239445303151952,5.56292888151909e-16},{2239541276091442,5.593378587248462e-16}, + {2239634642459498,5.623760510690043e-16},{2239725483455293,5.65407812864896e-16}, + {2239813876495186,5.684334850436814e-16},{2239899895417494,5.714534021509204e-16}, + {2239983610673676,5.744678926941961e-16},{2240065089506935,5.774772794756965e-16}, + {2240144396119183,5.804818799107686e-16},{2240221591827230,5.834820063333892e-16}, + {2240296735208969,5.864779662894365e-16},{2240369882240293,5.894700628185872e-16}, + {2240441086423386,5.924585947256134e-16},{2240510398907004,5.95443856841806e-16}, + {2240577868599305,5.984261402772028e-16},{2240643542273726,6.014057326642664e-16}, + {2240707464668391,6.043829183936125e-16},{2240769678579486,6.073579788423606e-16}, + {2240830224948980,6.103311925956439e-16},{2240889142947082,6.133028356617911e-16}, + {2240946470049769,6.162731816816596e-16},{2241002242111691,6.192425021325847e-16}, + {2241056493434746,6.222110665273788e-16},{2241109256832602,6.251791426088e-16}, + {2241160563691400,6.281469965398895e-16},{2241210444026879,6.311148930905604e-16}, + {2241258926538122,6.34083095820806e-16},{2241306038658137,6.370518672608815e-16}, + {2241351806601435,6.400214690888025e-16},{2241396255408788,6.429921623054896e-16}, + {2241439408989313,6.459642074078832e-16},{2241481290160038,6.489378645603397e-16}, + {2241521920683062,6.519133937646159e-16},{2241561321300462,6.548910550287415e-16}, + {2241599511767028,6.578711085350741e-16},{2241636510880960,6.608538148078259e-16}, + {2241672336512612,6.638394348803506e-16},{2241707005631362,6.668282304624746e-16}, + {2241740534330713,6.698204641081558e-16},{2241772937851689,6.728163993837531e-16}, + {2241804230604585,6.758163010371901e-16},{2241834426189161,6.78820435168298e-16}, + {2241863537413311,6.818290694006254e-16},{2241891576310281,6.848424730550038e-16}, + {2241918554154466,6.878609173251664e-16},{2241944481475843,6.908846754557169e-16}, + {2241969368073071,6.939140229227569e-16},{2241993223025298,6.969492376174829e-16}, + {2242016054702685,6.999906000330764e-16},{2242037870775710,7.030383934552151e-16}, + {2242058678223225,7.060929041565482e-16},{2242078483339331,7.091544215954873e-16}, + {2242097291739040,7.122232386196779e-16},{2242115108362774,7.152996516745303e-16}, + {2242131937479672,7.183839610172063e-16},{2242147782689725,7.214764709364707e-16}, + {2242162646924736,7.245774899788387e-16},{2242176532448092,7.276873311814693e-16}, + {2242189440853337,7.308063123122743e-16},{2242201373061537,7.339347561177405e-16}, + {2242212329317416,7.370729905789831e-16},{2242222309184237,7.4022134917658e-16}, + {2242231311537397,7.433801711647648e-16},{2242239334556717,7.465498018555889e-16}, + {2242246375717369,7.497305929136979e-16},{2242252431779415,7.529229026624058e-16}, + {2242257498775893,7.561270964017922e-16},{2242261571999416,7.5934354673958895e-16}, + {2242264645987196,7.625726339356756e-16},{2242266714504453,7.658147462610487e-16}, + {2242267770526109,7.690702803721919e-16},{2242267806216711,7.723396417018299e-16}, + {2242266812908462,7.756232448671174e-16},{2242264781077289,7.789215140963852e-16}, + {2242261700316818,7.822348836756411e-16},{2242257559310145,7.855637984161084e-16}, + {2242252345799276,7.889087141441755e-16},{2242246046552082,7.922700982152271e-16}, + {2242238647326615,7.956484300529366e-16},{2242230132832625,7.99044201715713e-16}, + {2242220486690076,8.024579184921259e-16},{2242209691384458,8.058900995272657e-16}, + {2242197728218684,8.093412784821501e-16},{2242184577261310,8.128120042284501e-16}, + {2242170217290819,8.163028415809877e-16},{2242154625735679,8.198143720706533e-16}, + {2242137778609839,8.23347194760605e-16},{2242119650443327,8.26901927108847e-16}, + {2242100214207556,8.304792058805374e-16},{2242079441234906,8.340796881136629e-16}, + {2242057301132135,8.377040521420222e-16},{2242033761687079,8.413529986798028e-16}, + {2242008788768107,8.450272519724097e-16},{2241982346215682,8.487275610186155e-16}, + {2241954395725356,8.524547008695596e-16},{2241924896721443,8.562094740106233e-16}, + {2241893806220517,8.599927118327665e-16},{2241861078683830,8.638052762005259e-16}, + {2241826665857598,8.676480611245582e-16},{2241790516600041,8.715219945473698e-16}, + {2241752576693881,8.754280402517175e-16},{2241712788642916,8.793671999021043e-16}, + {2241671091451078,8.833405152308408e-16},{2241627420382235,8.873490703813135e-16}, + {2241581706698773,8.913939944224086e-16},{2241533877376767,8.954764640495068e-16}, + {2241483854795281,8.9959770648911e-16},{2241431556397035,9.037590026260118e-16}, + {2241376894317345,9.079616903740068e-16},{2241319774977817,9.122071683134846e-16}, + {2241260098640860,9.164968996219135e-16},{2241197758920538,9.208324163262308e-16}, + {2241132642244704,9.252153239095693e-16},{2241064627262652,9.296473063086417e-16}, + {2240993584191742,9.341301313425265e-16},{2240919374095536,9.38665656618666e-16}, + {2240841848084890,9.432558359676707e-16},{2240760846432232,9.479027264651738e-16}, + {2240676197587784,9.526084961066279e-16},{2240587717084782,9.57375432209745e-16}, + {2240495206318753,9.622059506294838e-16},{2240398451183567,9.671026058823054e-16}, + {2240297220544165,9.720681022901626e-16},{2240191264522612,9.771053062707209e-16}, + {2240080312570155,9.822172599190541e-16},{2239964071293331,9.874071960480671e-16}, + {2239842221996530,9.926785548807976e-16},{2239714417896699,9.980350026183645e-16}, + {2239580280957725,1.003480452143618e-15},{2239439398282193,1.0090190861637457e-15}, + {2239291317986196,1.0146553831467086e-15},{2239135544468203,1.0203941464683124e-15}, + {2238971532964979,1.0262405372613567e-15},{2238798683265269,1.0322001115486456e-15}, + {2238616332424351,1.03827886235154e-15},{2238423746288095,1.044483267600047e-15}, + {2238220109591890,1.0508203448355195e-15},{2238004514345216,1.057297713900989e-15}, + {2237775946143212,1.06392366906768e-15},{2237533267957822,1.0707072623632994e-15}, + {2237275200846753,1.0776584002668106e-15},{2237000300869952,1.0847879564403425e-15}, + {2236706931309099,1.0921079038149563e-15},{2236393229029147,1.0996314701785628e-15}, + {2236057063479501,1.1073733224935752e-15},{2235695986373246,1.1153497865853155e-15}, + {2235307169458859,1.1235791107110833e-15},{2234887326941578,1.1320817840164846e-15}, + {2234432617919447,1.140880924258278e-15},{2233938522519765,1.1500027537839792e-15}, + {2233399683022677,1.159477189144919e-15},{2232809697779198,1.169338578691096e-15}, + {2232160850599817,1.17962663529558e-15},{2231443750584641,1.190387629928289e-15}, + {2230646845562170,1.2016759392543819e-15},{2229755753817986,1.2135560818666897e-15}, + {2228752329126533,1.2261054417450561e-15},{2227613325162504,1.2394179789163251e-15}, + {2226308442121174,1.2536093926602567e-15},{2224797391720399,1.268824481425501e-15}, + {2223025347823832,1.2852479319096109e-15},{2220915633329809,1.3031206634689985e-15}, + {2218357446087030,1.3227655770195326e-15},{2215184158448668,1.3446300925011171e-15}, + {2211132412537369,1.3693606835128518e-15},{2205758503851065,1.397943667277524e-15}, + {2198248265654987,1.4319989869661328e-15},{2186916352102141,1.4744848603597596e-15}, + {2167562552481814,1.5317872741611144e-15},{2125549880839716,1.6227698675312968e-15}}). + +normal_fi(Indx) -> + element(Indx, + {1.0000000000000000e+00,9.7710170126767082e-01,9.5987909180010600e-01, + 9.4519895344229909e-01,9.3206007595922991e-01,9.1999150503934646e-01, + 9.0872644005213032e-01,8.9809592189834297e-01,8.8798466075583282e-01, + 8.7830965580891684e-01,8.6900868803685649e-01,8.6003362119633109e-01, + 8.5134625845867751e-01,8.4291565311220373e-01,8.3471629298688299e-01, + 8.2672683394622093e-01,8.1892919160370192e-01,8.1130787431265572e-01, + 8.0384948317096383e-01,7.9654233042295841e-01,7.8937614356602404e-01, + 7.8234183265480195e-01,7.7543130498118662e-01,7.6863731579848571e-01, + 7.6195334683679483e-01,7.5537350650709567e-01,7.4889244721915638e-01, + 7.4250529634015061e-01,7.3620759812686210e-01,7.2999526456147568e-01, + 7.2386453346862967e-01,7.1781193263072152e-01,7.1183424887824798e-01, + 7.0592850133275376e-01,7.0009191813651117e-01,6.9432191612611627e-01, + 6.8861608300467136e-01,6.8297216164499430e-01,6.7738803621877308e-01, + 6.7186171989708166e-01,6.6639134390874977e-01,6.6097514777666277e-01, + 6.5561147057969693e-01,6.5029874311081637e-01,6.4503548082082196e-01, + 6.3982027745305614e-01,6.3465179928762327e-01,6.2952877992483625e-01, + 6.2445001554702606e-01,6.1941436060583399e-01,6.1442072388891344e-01, + 6.0946806492577310e-01,6.0455539069746733e-01,5.9968175261912482e-01, + 5.9484624376798689e-01,5.9004799633282545e-01,5.8528617926337090e-01, + 5.8055999610079034e-01,5.7586868297235316e-01,5.7121150673525267e-01, + 5.6658776325616389e-01,5.6199677581452390e-01,5.5743789361876550e-01, + 5.5291049042583185e-01,5.4841396325526537e-01,5.4394773119002582e-01, + 5.3951123425695158e-01,5.3510393238045717e-01,5.3072530440366150e-01, + 5.2637484717168403e-01,5.2205207467232140e-01,5.1775651722975591e-01, + 5.1348772074732651e-01,5.0924524599574761e-01,5.0502866794346790e-01, + 5.0083757512614835e-01,4.9667156905248933e-01,4.9253026364386815e-01, + 4.8841328470545758e-01,4.8432026942668288e-01,4.8025086590904642e-01, + 4.7620473271950547e-01,4.7218153846772976e-01,4.6818096140569321e-01, + 4.6420268904817391e-01,4.6024641781284248e-01,4.5631185267871610e-01, + 4.5239870686184824e-01,4.4850670150720273e-01,4.4463556539573912e-01, + 4.4078503466580377e-01,4.3695485254798533e-01,4.3314476911265209e-01, + 4.2935454102944126e-01,4.2558393133802180e-01,4.2183270922949573e-01, + 4.1810064983784795e-01,4.1438753404089090e-01,4.1069314827018799e-01, + 4.0701728432947315e-01,4.0335973922111429e-01,3.9972031498019700e-01, + 3.9609881851583223e-01,3.9249506145931540e-01,3.8890886001878855e-01, + 3.8534003484007706e-01,3.8178841087339344e-01,3.7825381724561896e-01, + 3.7473608713789086e-01,3.7123505766823922e-01,3.6775056977903225e-01, + 3.6428246812900372e-01,3.6083060098964775e-01,3.5739482014578022e-01, + 3.5397498080007656e-01,3.5057094148140588e-01,3.4718256395679348e-01, + 3.4380971314685055e-01,3.4045225704452164e-01,3.3711006663700588e-01, + 3.3378301583071823e-01,3.3047098137916342e-01,3.2717384281360129e-01, + 3.2389148237639104e-01,3.2062378495690530e-01,3.1737063802991350e-01, + 3.1413193159633707e-01,3.1090755812628634e-01,3.0769741250429189e-01, + 3.0450139197664983e-01,3.0131939610080288e-01,2.9815132669668531e-01, + 2.9499708779996164e-01,2.9185658561709499e-01,2.8872972848218270e-01, + 2.8561642681550159e-01,2.8251659308370741e-01,2.7943014176163772e-01, + 2.7635698929566810e-01,2.7329705406857691e-01,2.7025025636587519e-01, + 2.6721651834356114e-01,2.6419576399726080e-01,2.6118791913272082e-01, + 2.5819291133761890e-01,2.5521066995466168e-01,2.5224112605594190e-01, + 2.4928421241852824e-01,2.4633986350126363e-01,2.4340801542275012e-01, + 2.4048860594050039e-01,2.3758157443123795e-01,2.3468686187232990e-01, + 2.3180441082433859e-01,2.2893416541468023e-01,2.2607607132238020e-01, + 2.2323007576391746e-01,2.2039612748015194e-01,2.1757417672433113e-01, + 2.1476417525117358e-01,2.1196607630703015e-01,2.0917983462112499e-01, + 2.0640540639788071e-01,2.0364274931033485e-01,2.0089182249465656e-01, + 1.9815258654577511e-01,1.9542500351413428e-01,1.9270903690358912e-01, + 1.9000465167046496e-01,1.8731181422380025e-01,1.8463049242679927e-01, + 1.8196065559952254e-01,1.7930227452284767e-01,1.7665532144373500e-01, + 1.7401977008183875e-01,1.7139559563750595e-01,1.6878277480121151e-01, + 1.6618128576448205e-01,1.6359110823236570e-01,1.6101222343751107e-01, + 1.5844461415592431e-01,1.5588826472447920e-01,1.5334316106026283e-01, + 1.5080929068184568e-01,1.4828664273257453e-01,1.4577520800599403e-01, + 1.4327497897351341e-01,1.4078594981444470e-01,1.3830811644855071e-01, + 1.3584147657125373e-01,1.3338602969166913e-01,1.3094177717364430e-01, + 1.2850872227999952e-01,1.2608687022018586e-01,1.2367622820159654e-01, + 1.2127680548479021e-01,1.1888861344290998e-01,1.1651166562561080e-01, + 1.1414597782783835e-01,1.1179156816383801e-01,1.0944845714681163e-01, + 1.0711666777468364e-01,1.0479622562248690e-01,1.0248715894193508e-01, + 1.0018949876880981e-01,9.7903279038862284e-02,9.5628536713008819e-02, + 9.3365311912690860e-02,9.1113648066373634e-02,8.8873592068275789e-02, + 8.6645194450557961e-02,8.4428509570353374e-02,8.2223595813202863e-02, + 8.0030515814663056e-02,7.7849336702096039e-02,7.5680130358927067e-02, + 7.3522973713981268e-02,7.1377949058890375e-02,6.9245144397006769e-02, + 6.7124653827788497e-02,6.5016577971242842e-02,6.2921024437758113e-02, + 6.0838108349539864e-02,5.8767952920933758e-02,5.6710690106202902e-02, + 5.4666461324888914e-02,5.2635418276792176e-02,5.0617723860947761e-02, + 4.8613553215868521e-02,4.6623094901930368e-02,4.4646552251294443e-02, + 4.2684144916474431e-02,4.0736110655940933e-02,3.8802707404526113e-02, + 3.6884215688567284e-02,3.4980941461716084e-02,3.3093219458578522e-02, + 3.1221417191920245e-02,2.9365939758133314e-02,2.7527235669603082e-02, + 2.5705804008548896e-02,2.3902203305795882e-02,2.2117062707308864e-02, + 2.0351096230044517e-02,1.8605121275724643e-02,1.6880083152543166e-02, + 1.5177088307935325e-02,1.3497450601739880e-02,1.1842757857907888e-02, + 1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03, + 5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03, + 1.2602859304985975e-03}). diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index 3fe359af0e..0fca7ff8c7 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -23,7 +23,7 @@ -module(shell_default). -export([help/0,lc/1,c/1,c/2,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1, - memory/0,memory/1, + memory/0,memory/1,uptime/0, erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1, y/1, y/2, xm/1, bt/1, q/0, @@ -92,6 +92,7 @@ pid(X,Y,Z) -> c:pid(X,Y,Z). pwd() -> c:pwd(). q() -> c:q(). regs() -> c:regs(). +uptime() -> c:uptime(). xm(Mod) -> c:xm(Mod). y(File) -> c:y(File). y(File, Opts) -> c:y(File, Opts). diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index d4d2237b38..a27a35dca2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -84,6 +84,7 @@ qlc, qlc_pt, queue, + rand, random, re, sets, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 9bf10ea494..61eb34d565 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -54,6 +54,7 @@ MODULES= \ proc_lib_SUITE \ qlc_SUITE \ queue_SUITE \ + rand_SUITE \ random_SUITE \ re_SUITE \ run_pcre_tests \ diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 69814e12ce..ab624e8dd2 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,16 +25,16 @@ -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_testcase/2,end_per_testcase/2, - create/1,store/1]). + create/1,store/1,iterate/1]). -include_lib("test_server/include/test_server.hrl"). --import(lists, [foldl/3,reverse/1]). +-import(lists, [foldl/3]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [create, store]. + [create, store, iterate]. groups() -> []. @@ -93,6 +93,48 @@ store_1(List, M) -> D0. %%% +%%% Test specifics for gb_trees. +%%% + +iterate(Config) when is_list(Config) -> + test_all(fun iterate_1/1). + +iterate_1(M) -> + case M(module, []) of + gb_trees -> iterate_2(M); + _ -> ok + end, + M(empty, []). + +iterate_2(M) -> + random:seed(1, 2, 42), + iter_tree(M, 1000). + +iter_tree(_M, 0) -> + ok; +iter_tree(M, N) -> + L = [{I, I} || I <- lists:seq(1, N)], + T = M(from_list, L), + L = lists:reverse(iterate_tree(M, T)), + R = random:uniform(N), + KV = lists:reverse(iterate_tree_from(M, R, T)), + KV = [P || P={K,_} <- L, K >= R], + iter_tree(M, N-1). + +iterate_tree(M, Tree) -> + I = M(iterator, Tree), + iterate_tree_1(M, M(next, I), []). + +iterate_tree_from(M, Start, Tree) -> + I = M(iterator_from, {Start, Tree}), + iterate_tree_1(M, M(next, I), []). + +iterate_tree_1(_, none, R) -> + R; +iterate_tree_1(M, {K, V, I}, R) -> + iterate_tree_1(M, M(next, I), [{K, V} | R]). + +%%% %%% Helper functions. %%% diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl index 4fdb4fa0bd..81d26ce5f8 100644 --- a/lib/stdlib/test/dict_test_lib.erl +++ b/lib/stdlib/test/dict_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -29,6 +29,9 @@ new(Mod, Eq) -> (module, []) -> Mod; (size, D) -> Mod:size(D); (is_empty, D) -> Mod:is_empty(D); + (iterator, S) -> Mod:iterator(S); + (iterator_from, {Start, S}) -> Mod:iterator_from(Start, S); + (next, I) -> Mod:next(I); (to_list, D) -> to_list(Mod, D) end. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 5774d774b5..41bd4af241 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -3821,46 +3821,99 @@ match_object(Config) when is_list(Config) -> repeat_for_opts(match_object_do). match_object_do(Opts) -> - ?line EtsMem = etsmem(), - ?line Tab = ets_new(foobar, Opts), - ?line fill_tab(Tab, foo), - ?line ets:insert(Tab, {{one, 4}, 4}), - ?line ets:insert(Tab,{{one,5},5}), - ?line ets:insert(Tab,{{two,4},4}), - ?line ets:insert(Tab,{{two,5},6}), - ?line ets:insert(Tab, {#{camembert=>cabécou},7}), - ?line case ets:match_object(Tab, {{one, '_'}, '$0'}) of + EtsMem = etsmem(), + Tab = ets_new(foobar, Opts), + fill_tab(Tab, foo), + ets:insert(Tab,{{one,4},4}), + ets:insert(Tab,{{one,5},5}), + ets:insert(Tab,{{two,4},4}), + ets:insert(Tab,{{two,5},6}), + ets:insert(Tab, {#{camembert=>cabécou},7}), + ets:insert(Tab, {#{"hi"=>"hello","wazzup"=>"awesome","1337"=>"42"},8}), + ets:insert(Tab, {#{"hi"=>"hello",#{"wazzup"=>3}=>"awesome","1337"=>"42"},9}), + ets:insert(Tab, {#{"hi"=>"hello","wazzup"=>#{"awesome"=>3},"1337"=>"42"},10}), + Is = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I <- Is]), + M2 = maps:from_list([{I,"hi"}||I <- Is]), + ets:insert(Tab, {M1,11}), + ets:insert(Tab, {M2,12}), + + case ets:match_object(Tab, {{one, '_'}, '$0'}) of [{{one,5},5},{{one,4},4}] -> ok; [{{one,4},4},{{one,5},5}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, - ?line case ets:match_object(Tab, {{two, '$1'}, '$0'}) of + case ets:match_object(Tab, {{two, '$1'}, '$0'}) of [{{two,5},6},{{two,4},4}] -> ok; [{{two,4},4},{{two,5},6}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, - ?line case ets:match_object(Tab, {{two, '$9'}, '$4'}) of + case ets:match_object(Tab, {{two, '$9'}, '$4'}) of [{{two,5},6},{{two,4},4}] -> ok; [{{two,4},4},{{two,5},6}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, - ?line case ets:match_object(Tab, {{two, '$9'}, '$22'}) of + case ets:match_object(Tab, {{two, '$9'}, '$22'}) of [{{two,5},6},{{two,4},4}] -> ok; [{{two,4},4},{{two,5},6}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, + % Check that maps are inspected for variables. - [{#{camembert:=cabécou},7}] = - ets:match_object(Tab, {#{camembert=>'_'},7}), + [{#{camembert:=cabécou},7}] = ets:match_object(Tab, {#{camembert=>'_'},7}), + + [{#{"hi":="hello",#{"wazzup"=>3}:="awesome","1337":="42"},9}] = + ets:match_object(Tab, {#{#{"wazzup"=>3}=>"awesome","hi"=>"hello","1337"=>"42"},9}), + [{#{"hi":="hello",#{"wazzup"=>3}:="awesome","1337":="42"},9}] = + ets:match_object(Tab, {#{#{"wazzup"=>3}=>"awesome","hi"=>"hello","1337"=>'_'},'_'}), + [{#{"hi":="hello","wazzup":=#{"awesome":=3},"1337":="42"},10}] = + ets:match_object(Tab, {#{"wazzup"=>'_',"hi"=>'_',"1337"=>'_'},10}), + + %% multiple patterns + Pat = {{#{#{"wazzup"=>3}=>"awesome","hi"=>"hello","1337"=>'_'},'$1'},[{is_integer,'$1'}],['$_']}, + [{#{"hi":="hello",#{"wazzup"=>3}:="awesome","1337":="42"},9}] = + ets:select(Tab, [Pat,Pat,Pat,Pat]), + case ets:match_object(Tab, {#{"hi"=>"hello","wazzup"=>'_',"1337"=>"42"},'_'}) of + [{#{"1337" := "42","hi" := "hello","wazzup" := "awesome"},8}, + {#{"1337" := "42","hi" := "hello","wazzup" := #{"awesome" := 3}},10}] -> ok; + [{#{"1337" := "42","hi" := "hello","wazzup" := #{"awesome" := 3}},10}, + {#{"1337" := "42","hi" := "hello","wazzup" := "awesome"},8}] -> ok; + _ -> ?t:fail("ets:match_object() returned something funny.") + end, + case ets:match_object(Tab, {#{"hi"=>'_'},'_'}) of + [{#{"1337":="42", "hi":="hello"},_}, + {#{"1337":="42", "hi":="hello"},_}, + {#{"1337":="42", "hi":="hello"},_}] -> ok; + _ -> ?t:fail("ets:match_object() returned something funny.") + end, + + %% match large maps + [{#{1:=1,2:=2,99:=99,100:=100},11}] = ets:match_object(Tab, {M1,11}), + [{#{1:="hi",2:="hi",99:="hi",100:="hi"},12}] = ets:match_object(Tab, {M2,12}), + case ets:match_object(Tab, {#{1=>'_',2=>'_'},'_'}) of + %% only match a part of the map + [{#{1:=1,5:=5,99:=99,100:=100},11},{#{1:="hi",6:="hi",99:="hi"},12}] -> ok; + [{#{1:="hi",2:="hi",59:="hi"},12},{#{1:=1,2:=2,39:=39,100:=100},11}] -> ok; + _ -> ?t:fail("ets:match_object() returned something funny.") + end, + case ets:match_object(Tab, {maps:from_list([{I,'_'}||I<-Is]),'_'}) of + %% only match a part of the map + [{#{1:=1,5:=5,99:=99,100:=100},11},{#{1:="hi",6:="hi",99:="hi"},12}] -> ok; + [{#{1:="hi",2:="hi",59:="hi"},12},{#{1:=1,2:=2,39:=39,100:=100},11}] -> ok; + _ -> ?t:fail("ets:match_object() returned something funny.") + end, {'EXIT',{badarg,_}} = (catch ets:match_object(Tab, {#{'$1'=>'_'},7})), - % Check that unsucessful match returns an empty list. - ?line [] = ets:match_object(Tab, {{three,'$0'}, '$92'}), + Mve = maps:from_list([{list_to_atom([$$|integer_to_list(I)]),'_'}||I<-Is]), + {'EXIT',{badarg,_}} = (catch ets:match_object(Tab, {Mve,11})), + + % Check that unsuccessful match returns an empty list. + [] = ets:match_object(Tab, {{three,'$0'}, '$92'}), % Check that '$0' equals '_'. Len = length(ets:match_object(Tab, '$0')), Len = length(ets:match_object(Tab, '_')), - ?line if Len > 4 -> ok end, - ?line true = ets:delete(Tab), - ?line verify_etsmem(EtsMem). + if Len > 4 -> ok end, + true = ets:delete(Tab), + verify_etsmem(EtsMem). match_object2(suite) -> []; match_object2(doc) -> ["Tests that db_match_object does not generate " diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index 6f1d1a891d..70e7ad9788 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -395,6 +395,8 @@ split(Config) when is_list(Config) -> ?line ["foo", "bar", "hello"]= filename:split("foo////bar//hello"), ?line ["foo", "bar", "hello"]= filename:split(["foo//",'//bar//h',"ello"]), ?line ["foo", "bar", "hello"]= filename:split(["foo//",'//bar//h'|ello]), + ["/"] = filename:split("/"), + [] = filename:split(""), case os:type() of {win32,_} -> ?line ["a:/","msdev","include"] = @@ -767,6 +769,8 @@ split_bin(Config) when is_list(Config) -> [<<"/">>,<<"usr">>,<<"local">>,<<"bin">>] = filename:split(<<"/usr/local/bin">>), [<<"foo">>,<<"bar">>]= filename:split(<<"foo/bar">>), [<<"foo">>, <<"bar">>, <<"hello">>]= filename:split(<<"foo////bar//hello">>), + [<<"/">>] = filename:split(<<"/">>), + [] = filename:split(<<"">>), case os:type() of {win32,_} -> [<<"a:/">>,<<"msdev">>,<<"include">>] = diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 1d9c041a74..21e146ae3d 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -34,7 +34,7 @@ -export([init_per_testcase/2]). -export([end_per_testcase/2]). --export([t_get_3/1, +-export([t_get_3/1, t_filter_2/1, t_fold_3/1,t_map_2/1,t_size_1/1, t_with_2/1,t_without_2/1]). @@ -45,7 +45,7 @@ suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [t_get_3, + [t_get_3,t_filter_2, t_fold_3,t_map_2,t_size_1, t_with_2,t_without_2]. @@ -99,6 +99,16 @@ t_with_2(_Config) -> ?badarg(with,[a,#{}]) = (catch maps:with(a,#{})), ok. +t_filter_2(Config) when is_list(Config) -> + M = #{a => 2, b => 3, c=> 4, "a" => 1, "b" => 2, "c" => 4}, + Pred1 = fun(K,V) -> is_atom(K) andalso (V rem 2) =:= 0 end, + Pred2 = fun(K,V) -> is_list(K) andalso (V rem 2) =:= 0 end, + #{a := 2,c := 4} = maps:filter(Pred1,M), + #{"b" := 2,"c" := 4} = maps:filter(Pred2,M), + %% error case + ?badmap(a,filter,[_,a]) = (catch maps:filter(fun(_,_) -> ok end,id(a))), + ?badarg(filter,[<<>>,#{}]) = (catch maps:filter(id(<<>>),#{})), + ok. t_fold_3(Config) when is_list(Config) -> Vs = lists:seq(1,200), diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl new file mode 100644 index 0000000000..9a1f37aa75 --- /dev/null +++ b/lib/stdlib/test/rand_SUITE.erl @@ -0,0 +1,527 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(rand_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_testcase/2, end_per_testcase/2 + ]). + +-export([interval_int/1, interval_float/1, seed/1, + api_eq/1, reference/1, basic_stats/1, + plugin/1, measure/1 + ]). + +-export([test/0, gen/1]). + +-include_lib("test_server/include/test_server.hrl"). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). +-define(LOOP, 1000000). + +init_per_testcase(_Case, Config) -> + Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. +end_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [seed, interval_int, interval_float, + api_eq, + reference, + basic_stats, + plugin, measure + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% A simple helper to test without test_server during dev +test() -> + Tests = all(), + lists:foreach(fun(Test) -> + try + ok = ?MODULE:Test([]), + io:format("~p: ok~n", [Test]) + catch _:Reason -> + io:format("Failed: ~p: ~p ~p~n", + [Test, Reason, erlang:get_stacktrace()]) + end + end, Tests). + +algs() -> + [exs64, exsplus, exs1024]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +seed(doc) -> + ["Test that seed and seed_s and export_seed/0 is working."]; +seed(suite) -> + []; +seed(Config) when is_list(Config) -> + Algs = algs(), + Test = fun(Alg) -> + try seed_1(Alg) + catch _:Reason -> + test_server:fail({Alg, Reason, erlang:get_stacktrace()}) + end + end, + [Test(Alg) || Alg <- Algs], + ok. + +seed_1(Alg) -> + %% Check that uniform seeds automatically, + _ = rand:uniform(), + S00 = get(rand_seed), + erase(), + _ = rand:uniform(), + false = S00 =:= get(rand_seed), %% hopefully + + %% Choosing algo and seed + S0 = rand:seed(Alg, {0, 0, 0}), + %% Check that (documented?) process_dict variable is correct + S0 = get(rand_seed), + S0 = rand:seed_s(Alg, {0, 0, 0}), + %% Check that process_dict should not be used for seed_s functionality + _ = rand:seed_s(Alg, {1, 0, 0}), + S0 = get(rand_seed), + %% Test export + ES0 = rand:export_seed(), + ES0 = rand:export_seed_s(S0), + S0 = rand:seed(ES0), + S0 = rand:seed_s(ES0), + %% seed/1 calls should be unique + S1 = rand:seed(Alg), + false = (S1 =:= rand:seed_s(Alg)), + %% Negative integers works + _ = rand:seed_s(Alg, {-1,-1,-1}), + + %% Other term do not work + {'EXIT', _} = (catch rand:seed_s(foobar, os:timestamp())), + {'EXIT', _} = (catch rand:seed_s(Alg, {asd, 1, 1})), + {'EXIT', _} = (catch rand:seed_s(Alg, {0, 234.1234, 1})), + {'EXIT', _} = (catch rand:seed_s(Alg, {0, 234, [1, 123, 123]})), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_eq(doc) -> + ["Check that both api's are consistent with each other."]; +api_eq(suite) -> + []; +api_eq(_Config) -> + Algs = algs(), + Small = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + api_eq_1(Seed) + end, + _ = [Small(Alg) || Alg <- Algs], + ok. + +api_eq_1(S00) -> + Check = fun(_, Seed) -> + {V0, S0} = rand:uniform_s(Seed), + V0 = rand:uniform(), + {V1, S1} = rand:uniform_s(1000000, S0), + V1 = rand:uniform(1000000), + {V2, S2} = rand:normal_s(S1), + V2 = rand:normal(), + S2 + end, + S1 = lists:foldl(Check, S00, lists:seq(1, 200)), + S1 = get(rand_seed), + {V0, S2} = rand:uniform_s(S1), + V0 = rand:uniform(), + S2 = get(rand_seed), + + Exported = rand:export_seed(), + Exported = rand:export_seed_s(S2), + + S3 = lists:foldl(Check, S2, lists:seq(1, 200)), + S3 = get(rand_seed), + + S4 = lists:foldl(Check, S3, lists:seq(1, 200)), + S4 = get(rand_seed), + %% Verify that we do not have loops + false = S1 =:= S2, + false = S2 =:= S3, + false = S3 =:= S4, + + S2 = rand:seed(Exported), + S3 = lists:foldl(Check, S2, lists:seq(1, 200)), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +interval_int(doc) -> + ["Check that uniform/1 returns values within the proper interval."]; +interval_int(suite) -> + []; +interval_int(Config) when is_list(Config) -> + Algs = algs(), + Small = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + Max = interval_int_1(100000, 7, 0), + Max =:= 7 orelse exit({7, Alg, Max}) + end, + _ = [Small(Alg) || Alg <- Algs], + %% Test large integers + Large = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + Max = interval_int_1(100000, 1 bsl 128, 0), + Max > 1 bsl 64 orelse exit({large, Alg, Max}) + end, + [Large(Alg) || Alg <- Algs], + ok. + +interval_int_1(0, _, Max) -> Max; +interval_int_1(N, Top, Max) -> + X = rand:uniform(Top), + if + 0 < X, X =< Top -> + ok; + true -> + io:format("X=~p Top=~p 0<~p<~p~n", [X,Top,X,Top]), + exit({X, rand:export_seed()}) + end, + interval_int_1(N-1, Top, max(X, Max)). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +interval_float(doc) -> + ["Check that uniform/0 returns values within the proper interval."]; +interval_float(suite) -> + []; +interval_float(Config) when is_list(Config) -> + Algs = algs(), + Test = fun(Alg) -> + _ = rand:seed(Alg), + interval_float_1(100000) + end, + [Test(Alg) || Alg <- Algs], + ok. + +interval_float_1(0) -> ok; +interval_float_1(N) -> + X = rand:uniform(), + if + 0.0 < X, X < 1.0 -> + ok; + true -> + io:format("X=~p 0<~p<1.0~n", [X,X]), + exit({X, rand:export_seed()}) + end, + interval_float_1(N-1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +reference(doc) -> ["Check if exs64 algorithm generates the proper sequence."]; +reference(suite) -> []; +reference(Config) when is_list(Config) -> + [reference_1(Alg) || Alg <- algs()], + ok. + +reference_1(Alg) -> + Refval = reference_val(Alg), + Testval = gen(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + %% test_server:fail({Alg, Refval -- Testval}), + ok + end. + +gen(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed_s({exsplus, [12345678|12345678]}); + exs64 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs64, 12345678}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs1024, {lists:duplicate(16, 12345678), []}}); + _ -> + rand:seed(Algo, {100, 200, 300}) + end, + gen(?LOOP, Seed, []). + +gen(N, State0 = {#{max:=Max}, _}, Acc) when N > 0 -> + {Random, State} = rand:uniform_s(Max, State0), + case N rem (?LOOP div 100) of + 0 -> gen(N-1, State, [Random|Acc]); + _ -> gen(N-1, State, Acc) + end; +gen(_, _, Acc) -> lists:reverse(Acc). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This just tests the basics so we have not made any serious errors +%% when making the conversion from the original algorithms. +%% The algorithms must have good properties to begin with +%% + +basic_stats(doc) -> ["Check that the algorithms generate sound values."]; +basic_stats(suite) -> []; +basic_stats(Config) when is_list(Config) -> + io:format("Testing uniform~n",[]), + [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) + || Alg <- algs()], + [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) + || Alg <- algs()], + io:format("Testing normal~n",[]), + [basic_normal_1(?LOOP, rand:seed_s(Alg), 0, 0) || Alg <- algs()], + ok. + +basic_uniform_1(N, S0, Sum, A0) when N > 0 -> + {X,S} = rand:uniform_s(S0), + I = trunc(X*100), + A = array:set(I, 1+array:get(I,A0), A0), + basic_uniform_1(N-1, S, Sum+X, A); +basic_uniform_1(0, {#{type:=Alg}, _}, Sum, A) -> + AverN = Sum / ?LOOP, + io:format("~.10w: Average: ~.4f~n", [Alg, AverN]), + Counters = array:to_list(A), + Min = lists:min(Counters), + Max = lists:max(Counters), + io:format("~.10w: Min: ~p Max: ~p~n", [Alg, Min, Max]), + + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(0.5 - AverN) < 0.005 orelse test_server:fail({average, Alg, AverN}), + abs(?LOOP div 100 - Min) < 1000 orelse test_server:fail({min, Alg, Min}), + abs(?LOOP div 100 - Max) < 1000 orelse test_server:fail({max, Alg, Max}), + ok. + +basic_uniform_2(N, S0, Sum, A0) when N > 0 -> + {X,S} = rand:uniform_s(100, S0), + A = array:set(X-1, 1+array:get(X-1,A0), A0), + basic_uniform_2(N-1, S, Sum+X, A); +basic_uniform_2(0, {#{type:=Alg}, _}, Sum, A) -> + AverN = Sum / ?LOOP, + io:format("~.10w: Average: ~.4f~n", [Alg, AverN]), + Counters = tl(array:to_list(A)), + Min = lists:min(Counters), + Max = lists:max(Counters), + io:format("~.10w: Min: ~p Max: ~p~n", [Alg, Min, Max]), + + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(50.5 - AverN) < 0.5 orelse test_server:fail({average, Alg, AverN}), + abs(?LOOP div 100 - Min) < 1000 orelse test_server:fail({min, Alg, Min}), + abs(?LOOP div 100 - Max) < 1000 orelse test_server:fail({max, Alg, Max}), + ok. + +basic_normal_1(N, S0, Sum, Sq) when N > 0 -> + {X,S} = rand:normal_s(S0), + basic_normal_1(N-1, S, X+Sum, X*X+Sq); +basic_normal_1(0, {#{type:=Alg}, _}, Sum, SumSq) -> + Mean = Sum / ?LOOP, + StdDev = math:sqrt((SumSq - (Sum*Sum/?LOOP))/(?LOOP - 1)), + io:format("~.10w: Average: ~7.4f StdDev ~6.4f~n", [Alg, Mean, StdDev]), + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(Mean) < 0.005 orelse test_server:fail({average, Alg, Mean}), + abs(StdDev - 1.0) < 0.005 orelse test_server:fail({stddev, Alg, StdDev}), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +plugin(doc) -> ["Test that the user can write algorithms"]; +plugin(suite) -> []; +plugin(Config) when is_list(Config) -> + _ = lists:foldl(fun(_, S0) -> + {V1, S1} = rand:uniform_s(10000, S0), + true = is_integer(V1), + {V2, S2} = rand:uniform_s(S1), + true = is_float(V2), + S2 + end, crypto_seed(), lists:seq(1, 200)), + ok. + +%% Test implementation +crypto_seed() -> + {#{type=>crypto, + max=>(1 bsl 64)-1, + next=>fun crypto_next/1, + uniform=>fun crypto_uniform/1, + uniform_n=>fun crypto_uniform_n/2}, + <<>>}. + +%% Be fair and create bignums i.e. 64bits otherwise use 58bits +crypto_next(<<Num:64, Bin/binary>>) -> + {Num, Bin}; +crypto_next(_) -> + crypto_next(crypto:rand_bytes((64 div 8)*100)). + +crypto_uniform({Api, Data0}) -> + {Int, Data} = crypto_next(Data0), + {Int / (1 bsl 64), {Api, Data}}. + +crypto_uniform_n(N, {Api, Data0}) when N < (1 bsl 64) -> + {Int, Data} = crypto_next(Data0), + {(Int rem N)+1, {Api, Data}}; +crypto_uniform_n(N, State0) -> + {F,State} = crypto_uniform(State0), + {trunc(F * N) + 1, State}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Not a test but measures the time characteristics of the different algorithms +measure(Suite) when is_atom(Suite) -> []; +measure(_Config) -> + Algos = [crypto64|algs()], + io:format("RNG uniform integer performance~n",[]), + _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), + _ = [measure_1(Algo, fun(State) -> {int, rand:uniform_s(10000, State)} end) || Algo <- Algos], + io:format("RNG uniform float performance~n",[]), + _ = measure_1(random, fun(State) -> {uniform, random:uniform_s(State)} end), + _ = [measure_1(Algo, fun(State) -> {uniform, rand:uniform_s(State)} end) || Algo <- Algos], + io:format("RNG normal float performance~n",[]), + io:format("~.10w: not implemented (too few bits)~n", [random]), + _ = [measure_1(Algo, fun(State) -> {normal, rand:normal_s(State)} end) || Algo <- Algos], + ok. + +measure_1(Algo, Gen) -> + Parent = self(), + Seed = fun(crypto64) -> crypto_seed(); + (random) -> random:seed(os:timestamp()), get(random_seed); + (Alg) -> rand:seed_s(Alg) + end, + + Pid = spawn_link(fun() -> + Fun = fun() -> measure_2(?LOOP, Seed(Algo), Gen) end, + {Time, ok} = timer:tc(Fun), + io:format("~.10w: ~pµs~n", [Algo, Time]), + Parent ! {self(), ok}, + normal + end), + receive + {Pid, Msg} -> Msg + end. + +measure_2(N, State0, Fun) when N > 0 -> + case Fun(State0) of + {int, {Random, State}} + when is_integer(Random), Random >= 1, Random =< 100000 -> + measure_2(N-1, State, Fun); + {uniform, {Random, State}} when is_float(Random), Random > 0, Random < 1 -> + measure_2(N-1, State, Fun); + {normal, {Random, State}} when is_float(Random) -> + measure_2(N-1, State, Fun); + Res -> + exit({error, Res, State0}) + end; +measure_2(0, _, _) -> ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Data +reference_val(exs64) -> + [16#3737ad0c703ff6c3,16#3868a78fe71adbbd,16#1f01b62b4338b605,16#50876a917437965f, + 16#b2edfe32a10e27fc,16#995924551d8ebae1,16#9f1e6b94e94e0b58,16#27ec029eb0e94f8e, + 16#bf654e6df7fe5c,16#b7d5ef7b79be65e3,16#4bdba4d1c159126b,16#a9c816fdc701292c, + 16#a377b6c89d85ac8b,16#7abb5cd0e5847a6,16#62666f1fc00a0a90,16#1edc3c3d255a8113, + 16#dfc764073767f18e,16#381783d577ca4e34,16#49693588c085ddcb,16#da6fcb16dd5163f3, + 16#e2357a703475b1b7,16#aaa84c4924b5985a,16#b8fe07bb2bac1e49,16#23973ac0160ff064, + 16#1afbc7b023f5d618,16#9f510f7b7caa2a0f,16#d5b0a57f7f5f1084,16#d8c49b66c5f99a29, + 16#e920ac3b598b5213,16#1090d7e27e7a7c76,16#81171917168ee74f,16#f08489a3eb6988e, + 16#396260c4f0b2ed46,16#4fd0a6a6caefd5b2,16#423dff07a3b888a,16#12718773ebd99987, + 16#e50991e540807cb,16#8cfa03bbaa6679d6,16#55bdf86dfbb92dbf,16#eb7145378cce74a8, + 16#71856c224c846595,16#20461588dae6e24d,16#c73b3e63ced74bac,16#775b11813dda0c78, + 16#91f358e51068ede0,16#399955ef36766bc2,16#4489ee072e8a38b1,16#ba77759d52321ca0, + 16#14f519eab5c53db8,16#1f754bd08e4f34c4,16#99e25ca29b2fcfeb,16#da11927c0d9837f8, + 16#1eeb0f87009f5a87,16#a7c444d3b0db1089,16#49c7fbf0714849ad,16#4f2b693e7f8265cb, + 16#80e1493cbaa8f256,16#186f345bcac2661e,16#330065ae0c698d26,16#5235ed0432c42e93, + 16#429792e31ddb10bb,16#8769054bb6533cff,16#1ab382483444201f,16#2216368786fc7b9, + 16#1efea1155216da0b,16#782dc868ba595452,16#2b80f6d159617f48,16#407fc35121b2fa1b, + 16#90e8be6e618873d1,16#40ad4ec92a8abf8e,16#34e2890f583f435,16#838c0aef0a5d8427, + 16#ed4238f4bd6cbcfa,16#7feed11f7a8bb9f0,16#2b0636a93e26c89d,16#481ad4bea5180646, + 16#673e5ad861afe1cc,16#298eeb519d69e74d,16#eb1dd06d168c856,16#4770651519ee7ef9, + 16#7456ebf1bcf608f1,16#d6200f6fbd61ce05,16#c0695dfab11ab6aa,16#5bff449249983843, + 16#7aba88471474c9ac,16#d7e9e4a21c989e91,16#c5e02ee67ccb7ce1,16#4ea8a3a912246153, + 16#f2e6db7c9ce4ec43,16#39498a95d46d2470,16#c5294fcb8cce8aa9,16#a918fe444719f3dc, + 16#98225f754762c0c0,16#f0721204f2cb43f5,16#b98e77b099d1f2d1,16#691d6f75aee3386, + 16#860c7b2354ec24fd,16#33e007bd0fbcb609,16#7170ae9c20fb3d0,16#31d46938fe383a60]; + +reference_val(exs1024) -> + [16#9c61311d0d4a01fd,16#ce963ef5803b703e,16#545dcffb7b644e1a,16#edd56576a8d778d5, + 16#16bee799783c6b45,16#336f0b3caeb417fa,16#29291b8be26dedfa,16#1efed996d2e1b1a8, + 16#c5c04757bd2dadf9,16#11aa6d194009c616,16#ab2b3e82bdb38a91,16#5011ee46fd2609eb, + 16#766db7e5b701a9bb,16#d42cb2632c419f35,16#107c6a2667bf8557,16#3ffbf922cb306967, + 16#1e71e3d024ac5131,16#6fdb368ec67a5f06,16#b0d8e72e7aa6d1c1,16#e5705a02dae89e3b, + 16#9c24eb68c086a1d3,16#418de330f55f71f0,16#2917ddeb278bc8d2,16#aeba7fba67208f39, + 16#10ceaf40f6af1d8d,16#47a6d06811d33132,16#603a661d6caf720a,16#a28bd0c9bcdacb3c, + 16#f44754f006909762,16#6e25e8e67ccc43bc,16#174378ce374a549e,16#b5598ae9f57c4e50, + 16#ca85807fbcd51dd,16#1816e58d6c3cc32a,16#1b4d630d3c8e96a6,16#c19b1e92b4efc5bd, + 16#665597b20ddd721a,16#fdab4eb21b75c0ae,16#86a612dcfea0756c,16#8fc2da192f9a55f0, + 16#d7c954eb1af31b5,16#6f5ee45b1b80101b,16#ebe8ea4e5a67cbf5,16#1cb952026b4c1400, + 16#44e62caffe7452c0,16#b591d8f3e6d7cbcf,16#250303f8d77b6f81,16#8ef2199aae4c9b8d, + 16#a16baa37a14d7b89,16#c006e4d2b2da158b,16#e6ec7abd54c93b31,16#e6b0d79ae2ab6fa7, + 16#93e4b30e4ab7d4cd,16#42a01b6a4ef63033,16#9ab1e94fe94976e,16#426644e1de302a1f, + 16#8e58569192200139,16#744f014a090107c1,16#15d056801d467c6c,16#51bdad3a8c30225f, + 16#abfc61fb3104bd45,16#c610607122272df7,16#905e67c63116ebfc,16#1e4fd5f443bdc18, + 16#1945d1745bc55a4c,16#f7cd2b18989595bb,16#f0d273b2c646a038,16#ee9a6fdc6fd5d734, + 16#541a518bdb700518,16#6e67ab9a65361d76,16#bcfadc9bfe5b2e06,16#69fa334cf3c11496, + 16#9657df3e0395b631,16#fc0d0442160108ec,16#2ee538da7b1f7209,16#8b20c9fae50a5a9e, + 16#a971a4b5c2b3b6a,16#ff6241e32489438e,16#8fd6433f45255777,16#6e6c82f10818b0dc, + 16#59a8fad3f6af616b,16#7eac34f43f12221c,16#6e429ec2951723ec,16#9a65179767a45c37, + 16#a5f8127d1e6fdf35,16#932c50bc633d8d5c,16#f3bbea4e7ebecb8,16#efc3a2bbf6a8674, + 16#451644a99971cb6,16#cf70776d652c150d,16#c1fe0dcb87a25403,16#9523417132b2452e, + 16#8f98bc30d06b980e,16#bb4b288ecb8daa9a,16#59e54beb32f78045,16#f9ab1562456b9d66, + 16#6435f4130304a793,16#b4bb94c2002e1849,16#49a86d1e4bade982,16#457d63d60ed52b95]; + +reference_val(exsplus) -> + [16#bc76c2e638db,16#15ede2ebb16c9fb,16#185ee2c27d6b88d,16#15d5ee9feafc3a5, + 16#1862e91dfce3e6b,16#2c9744b0fb69e46,16#78b21bc01cef6b,16#2d16a2fae6c76ba, + 16#13dfccb8ff86bce,16#1d9474c59e23f4d,16#d2f67dcd7f0dd6,16#2b6d489d51a0725, + 16#1fa52ef484861d8,16#1ae9e2a38f966d4,16#2264ab1e193acca,16#23bbca085039a05, + 16#2b6eea06a0af0e1,16#3ad47fa8866ea20,16#1ec2802d612d855,16#36c1982b134d50, + 16#296b6a23f5b75e0,16#c5eeb600a9875c,16#2a3fd51d735f9d4,16#56fafa3593a070, + 16#13e9d416ec0423e,16#28101a91b23e9dc,16#32e561eb55ce15a,16#94a7dbba66fe4a, + 16#2e1845043bcec1f,16#235f7513a1b5146,16#e37af1bf2d63cb,16#2048033824a1639, + 16#c255c750995f7,16#2c7542058e89ee3,16#204dfeefbdb62ba,16#f5a936ec63dd66, + 16#33b3b7dbbbd8b90,16#c4f0f79026ffe9,16#20ffee2d37aca13,16#2274f931716be2c, + 16#29b883902ba9df1,16#1a838cd5312717f,16#2edfc49ff3dc1d6,16#418145cbec84c2, + 16#d2d8f1a17d49f,16#d41637bfa4cc6f,16#24437e03a0f5df8,16#3d1d87919b94a90, + 16#20d6997b36769b6,16#16f9d7855cd87ca,16#821ef7e2a062a3,16#2c4d11dc4a2da70, + 16#24a3b27f56ed26b,16#144b23c8b97387a,16#34a2ced56930d12,16#21cc0544113a017, + 16#3e780771f634fb2,16#146c259c02e7e18,16#1d99e4cfad0ef1,16#fdf3dabefc6b3a, + 16#7d0806e4d12dfb,16#3e3ae3580532eae,16#2456544200fbd86,16#f83aad4e88db85, + 16#37c134779463b4d,16#21a20bf64b6e735,16#1c0585ac88b69f2,16#1b3fcea8dd30e56, + 16#334bc301aefd97,16#37066eb7e80a946,16#15a19a6331b570f,16#35e67fa43c3f7d0, + 16#152a4020145fb80,16#8d55139491dfbe,16#21d9cba585c059d,16#31475f363654635, + 16#2567b17acb7a104,16#39201be3a7681c5,16#6bc675fd26b601,16#334b93232b1b1e3, + 16#357c402cb732c6a,16#362e32efe4db46a,16#8edc7ae3da51e5,16#31573376785eac9, + 16#6c6145ffa1169d,16#18ec2c393d45359,16#1f1a5f256e7130c,16#131cc2f49b8004f, + 16#36f715a249f4ec2,16#1c27629826c50d3,16#914d9a6648726a,16#27f5bf5ce2301e8, + 16#3dd493b8012970f,16#be13bed1e00e5c,16#ceef033b74ae10,16#3da38c6a50abe03, + 16#15cbd1a421c7a8c,16#22794e3ec6ef3b1,16#26154d26e7ea99f,16#3a66681359a6ab6]. diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl index c0cf1fc7e8..24f5d65f82 100644 --- a/lib/stdlib/test/sets_SUITE.erl +++ b/lib/stdlib/test/sets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,7 +28,7 @@ create/1,add_element/1,del_element/1, subtract/1,intersection/1,union/1,is_subset/1, is_set/1,fold/1,filter/1, - take_smallest/1,take_largest/1]). + take_smallest/1,take_largest/1, iterate/1]). -include_lib("test_server/include/test_server.hrl"). @@ -48,7 +48,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [create, add_element, del_element, subtract, intersection, union, is_subset, is_set, fold, filter, - take_smallest, take_largest]. + take_smallest, take_largest, iterate]. groups() -> []. @@ -426,6 +426,44 @@ take_largest_3(S0, List0, M) -> take_largest_3(S, List, M) end. +iterate(Config) when is_list(Config) -> + test_all(fun iterate_1/1). + +iterate_1(M) -> + case M(module, []) of + gb_sets -> iterate_2(M); + _ -> ok + end, + M(empty, []). + +iterate_2(M) -> + random:seed(1, 2, 42), + iter_set(M, 1000). + +iter_set(_M, 0) -> + ok; +iter_set(M, N) -> + L = [I || I <- lists:seq(1, N)], + T = M(from_list, L), + L = lists:reverse(iterate_set(M, T)), + R = random:uniform(N), + S = lists:reverse(iterate_set(M, R, T)), + S = [E || E <- L, E >= R], + iter_set(M, N-1). + +iterate_set(M, Set) -> + I = M(iterator, Set), + iterate_set_1(M, M(next, I), []). + +iterate_set(M, Start, Set) -> + I = M(iterator_from, {Start, Set}), + iterate_set_1(M, M(next, I), []). + +iterate_set_1(_, none, R) -> + R; +iterate_set_1(M, {E, I}, R) -> + iterate_set_1(M, M(next, I), [E | R]). + %%% %%% Helper functions. %%% diff --git a/lib/stdlib/test/sets_test_lib.erl b/lib/stdlib/test/sets_test_lib.erl index 86f009a8f9..772139406d 100644 --- a/lib/stdlib/test/sets_test_lib.erl +++ b/lib/stdlib/test/sets_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,10 @@ new(Mod, Eq) -> (is_empty, S) -> is_empty(Mod, S); (is_set, S) -> Mod:is_set(S); (is_subset, {S,Set}) -> is_subset(Mod, Eq, S, Set); + (iterator, S) -> Mod:iterator(S); + (iterator_from, {Start, S}) -> Mod:iterator_from(Start, S); (module, []) -> Mod; + (next, I) -> Mod:next(I); (singleton, E) -> singleton(Mod, E); (size, S) -> Mod:size(S); (subtract, {S1,S2}) -> subtract(Mod, S1, S2); diff --git a/lib/test_server/doc/src/example_chapter.xml b/lib/test_server/doc/src/example_chapter.xml index 0ebc85da09..6bc0cfaebe 100644 --- a/lib/test_server/doc/src/example_chapter.xml +++ b/lib/test_server/doc/src/example_chapter.xml @@ -47,7 +47,7 @@ -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> - ?line Dog=?t:timetrap(?default_timeout), + Dog=?t:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), @@ -72,8 +72,8 @@ not_started_func1(suite) -> not_started_func1(doc) -> ["Testing function 1 when application is not started"]. not_started_func1(Config) when list(Config) -> - ?line {error, not_started} = myapp:func1(dummy_ref,1), - ?line {error, not_started} = myapp:func1(dummy_ref,2), + {error, not_started} = myapp:func1(dummy_ref,1), + {error, not_started} = myapp:func1(dummy_ref,2), ok. not_started_func2(suite) -> @@ -81,8 +81,8 @@ not_started_func2(suite) -> not_started_func2(doc) -> ["Testing function 2 when application is not started"]. not_started_func2(Config) when list(Config) -> - ?line {error, not_started} = myapp:func2(dummy_ref,1), - ?line {error, not_started} = myapp:func2(dummy_ref,2), + {error, not_started} = myapp:func2(dummy_ref,1), + {error, not_started} = myapp:func2(dummy_ref,2), ok. @@ -90,7 +90,7 @@ not_started_func2(Config) when list(Config) -> start(doc) -> ["Testing start of my application."]; start(Config) when list(Config) -> - ?line Ref = myapp:start(), + Ref = myapp:start(), case erlang:whereis(my_main_process) of Pid when pid(Pid) -> [{myapp_ref,Ref}|Config]; @@ -105,9 +105,9 @@ func1(suite) -> func1(doc) -> ["Test that func1 returns ok when argument is 1 and error if argument is 2"]; func1(Config) when list(Config) -> - ?line Ref = ?config(myapp_ref,Config), - ?line ok = myapp:func1(Ref,1), - ?line error = myapp:func1(Ref,2), + Ref = ?config(myapp_ref,Config), + ok = myapp:func1(Ref,1), + error = myapp:func1(Ref,2), ok. func2(suite) -> @@ -115,17 +115,17 @@ func2(suite) -> func2(doc) -> ["Test that func1 returns ok when argument is 3 and error if argument is 4"]; func2(Config) when list(Config) -> - ?line Ref = ?config(myapp_ref,Config), - ?line ok = myapp:func2(Ref,3), - ?line error = myapp:func2(Ref,4), + Ref = ?config(myapp_ref,Config), + ok = myapp:func2(Ref,3), + error = myapp:func2(Ref,4), ok. %% No specification clause needed for a cleanup function in a conf case!!! stop(doc) -> ["Testing termination of my application"]; stop(Config) when list(Config) -> - ?line Ref = ?config(myapp_ref,Config), - ?line ok = myapp:stop(Ref), + Ref = ?config(myapp_ref,Config), + ok = myapp:stop(Ref), case erlang:whereis(my_main_process) of undefined -> lists:keydelete(myapp_ref,1,Config); diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml index ed5569e1fe..b98e434c03 100644 --- a/lib/test_server/doc/src/test_server.xml +++ b/lib/test_server/doc/src/test_server.xml @@ -811,46 +811,12 @@ Only valid for peer nodes. Note that slave nodes always </func> </funcs> - <section> - <title>TEST SUITE LINE NUMBERS</title> - <p>If a test case fails, the test server can report the exact line - number at which it failed. There are two ways of doing this, - either by using the <c>line</c> macro or by using the - <c>test_server_line</c> parse transform. - </p> - <p>The <c>line</c> macro is described under TEST SUITE SUPPORT - MACROS below. The <c>line</c> macro will only report the last line - executed when a test case failed. - </p> - <p>The <c>test_server_line</c> parse transform is activated by - including the headerfile <c>test_server_line.hrl</c> in the test - suite. When doing this, it is important that the - <c>test_server_line</c> module is in the code path of the erlang - node compiling the test suite. The parse transform will report a - history of a maximum of 10 lines when a test case - fails. Consecutive lines in the same function are not shown. - </p> - <p>The attribute <c>-no_lines(FuncList).</c> can be used in the - test suite to exclude specific functions from the parse - transform. This is necessary e.g. for functions that are executed - on old (i.e. <R10B) OTP releases. <c>FuncList = [{Func,Arity}]</c>. - </p> - <p>If both the <c>line</c> macro and the parse transform is used in - the same module, the parse transform will overrule the macro. - </p> - </section> <section> <title>TEST SUITE SUPPORT MACROS</title> <p>There are some macros defined in the <c>test_server.hrl</c> that are quite useful for test suite programmers: </p> - <p>The <em>line</em> macro, is quite - essential when writing test cases. It tells the test server - exactly what line of code that is being executed, so that it can - report this line back if the test case fails. Use this macro at - the beginning of every test case line of code. - </p> <p>The <em>config</em> macro, is used to retrieve information from the <c>Config</c> variable sent to all test cases. It is used with two arguments, where the first is the @@ -867,24 +833,20 @@ Only valid for peer nodes. Note that slave nodes always <item>Whatever added by conf test cases or <c>init_per_testcase/2</c></item> </list> - <p>Examples of the <c>line</c> and <c>config</c> macros can be - seen in the Examples chapter in the user's guide. - </p> - <p>If the <c>line_trace</c> macro is defined, you will get a - timestamp (<c>erlang:now()</c>) in your minor log for each - <c>line</c> macro in your suite. This way you can at any time see - which line is currently being executed, and when the line was - called. - </p> - <p>The <c>line_trace</c> macro can also be used together with the - <c>test_server_line</c> parse transform described above. A - timestamp will then be written for each line in the suite, except - for functions stated in the <c>-no_lines</c> attribute. - </p> - <p>The <c>line_trace</c> macro can e.g. be defined as a compile - option, like this: - <br></br> -<c>erlc -W -Dline_trace my_SUITE.erl</c></p> + <p>Examples of the <c>config</c> macro can be seen in the Examples chapter + in the user's guide.</p> + <p>The <em>line</em> and <em>line_trace</em> macros are deprecated, see + below.</p> + </section> + + <section> + <title>TEST SUITE LINE NUMBERS</title> + <p>In the past, ERTS did not produce line numbers when generating + stacktraces, test_server was thus unable to provide them when reporting + test failures. It had instead two different mecanisms to do it: either by + using the <c>line</c> macro or by using the <c>test_server_line</c> parse + transform. Both are deprecated and should not be used in new tests + anymore.</p> </section> </erlref> diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl index 36e7e1f83d..f206374116 100644 --- a/lib/test_server/include/test_server.hrl +++ b/lib/test_server/include/test_server.hrl @@ -21,7 +21,7 @@ -line_trace(true). -define(line, io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]), - [erlang:now()]),). + [erlang:monotonic_time()-erlang:system_info(start_time)]),). -else. -define(line,). -endif. diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index 2e443c7b8b..b0b5c40965 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -109,27 +109,26 @@ parse_file(File, InclPath) -> Error end. -parse_preprocessed_file(Epp,File,InCorrectFile) -> +parse_preprocessed_file(Epp, File, InCorrectFile) -> case epp:parse_erl_form(Epp) of {ok,Form} -> case Form of {attribute,_,file,{File,_}} -> - parse_preprocessed_file(Epp,File,true); + parse_preprocessed_file(Epp, File, true); {attribute,_,file,{_OtherFile,_}} -> - parse_preprocessed_file(Epp,File,false); + parse_preprocessed_file(Epp, File, false); {function,L,F,A,Cs} when InCorrectFile -> {CLs,LastCL} = find_clause_lines(Cs, []), - Clauses = [{clause,get_line(CL)} || - {clause,CL,_,_,_} <- tl(CLs)], - [{atom_to_list(F),A,get_line(L),get_line(LastCL)} | Clauses] ++ - parse_preprocessed_file(Epp,File,true); + %% tl(CLs) cause we know the start line already + [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ + parse_preprocessed_file(Epp, File, true); _ -> - parse_preprocessed_file(Epp,File,InCorrectFile) + parse_preprocessed_file(Epp, File, InCorrectFile) end; {error,Reason={_L,epp,{undefined,_Macro,none}}} -> throw({error,Reason,InCorrectFile}); {error,_Reason} -> - parse_preprocessed_file(Epp,File,InCorrectFile); + parse_preprocessed_file(Epp, File, InCorrectFile); {eof,_Location} -> [] end. @@ -150,9 +149,8 @@ parse_non_preprocessed_file(Epp, File, Location) -> try erl_syntax:revert(Tree) of {function,L,F,A,Cs} -> {CLs,LastCL} = find_clause_lines(Cs, []), - Clauses = [{clause,get_line(CL)} || - {clause,CL,_,_,_} <- tl(CLs)], - [{atom_to_list(F),A,get_line(L),get_line(LastCL)} | Clauses] ++ + %% tl(CLs) cause we know the start line already + [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ parse_non_preprocessed_file(Epp, File, Location1); _ -> parse_non_preprocessed_file(Epp, File, Location1) @@ -172,17 +170,21 @@ get_line(Anno) -> %%% Find the line number of the last expression in the function find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause try tuple_to_list(lists:last(Exprs)) of - [_Type,ExprLine | _] -> - {lists:reverse([{clause,CL}|CLs]), ExprLine}; + [_Type,ExprLine | _] when is_integer(ExprLine) -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; + [tree,_ | Exprs1] -> + find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs); + [macro,{_var,ExprLine,_MACRO} | _] when is_integer(ExprLine) -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; _ -> - {lists:reverse([{clause,CL}|CLs]), CL} + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} catch _:_ -> - {lists:reverse([{clause,CL}|CLs]), CL} + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} end; find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> - find_clause_lines(Cs, [{clause,CL}|CLs]). + find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]). %%%----------------------------------------------------------------- %%% Add a link target for each line and one for each function definition. @@ -190,18 +192,18 @@ build_html(SFd,DFd,Encoding,FuncsAndCs) -> build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs, false,undefined). -%% function start line found -build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs], - _IsFuncDef,_FAndLastL) -> - FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8), - file:write(DFd,["<a name=\"",to_raw_list(FALink,Enc),"\"/>"]), - build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL}); %% line of last expression in function found build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) -> LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8), file:write(DFd,["<a name=\"", to_raw_list(LastLineLink,Enc),"\"/>"]), build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined); +%% function start line found +build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs], + _IsFuncDef,_FAndLastL) -> + FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8), + file:write(DFd,["<a name=\"",to_raw_list(FALink,Enc),"\"/>"]), + build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL}); build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs], _IsFuncDef,FAndLastL) -> build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL); diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index 5538e8b851..bdd9d28444 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -32,7 +32,7 @@ test_server_break_process]}, {applications, [kernel,stdlib]}, {env, []}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.0","runtime_tools-1.8.14", - "observer-2.0","kernel-3.0","inets-5.10", - "syntax_tools-1.6.16","erts-7.0"]}]}. + {runtime_dependencies, ["tools-2.8","stdlib-2.5","runtime_tools-1.8.16", + "observer-2.1","kernel-4.0","inets-6.0", + "syntax_tools-1.7","erts-7.0"]}]}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7cb9c4bb5a..785e687b92 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -2491,11 +2491,7 @@ appup_test(App) -> %% Checks wether the module is natively compiled or not. is_native(Mod) -> - case catch Mod:module_info(native_addresses) of - [_|_] -> true; - _Other -> false - end. - + (catch Mod:module_info(native)) =:= true. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% comment(String) -> ok diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 469593e947..85f97656ff 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -262,18 +262,28 @@ run_all(_Vars) -> run_some([], _Opts) -> ok; -run_some([{App,Mod}|Apps], Opts) -> +run_some(Apps, Opts) -> + case proplists:get_value(test_category, Opts) of + bench -> + check_and_run(fun(Vars) -> ts_benchmark:run(Apps, Opts, Vars) end); + _Other -> + run_some1(Apps, Opts) + end. + +run_some1([], _Opts) -> + ok; +run_some1([{App,Mod}|Apps], Opts) -> case run(App, Mod, Opts) of ok -> ok; Error -> io:format("~p: ~p~n",[{App,Mod},Error]) end, - run_some(Apps, Opts); -run_some([App|Apps], Opts) -> + run_some1(Apps, Opts); +run_some1([App|Apps], Opts) -> case run(App, Opts) of ok -> ok; Error -> io:format("~p: ~p~n",[App,Error]) end, - run_some(Apps, Opts). + run_some1(Apps, Opts). %% This can be used from command line. Both App and %% TestCategory must be specified. App may be 'all' diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/test_server/test/erl2html2_SUITE.erl index 908985c879..796b84dedd 100644 --- a/lib/test_server/test/erl2html2_SUITE.erl +++ b/lib/test_server/test/erl2html2_SUITE.erl @@ -130,15 +130,7 @@ groups() -> %% @end %%-------------------------------------------------------------------- all() -> - [m1]. - -%%-------------------------------------------------------------------- -%% @spec TestCase() -> Info -%% Info = [tuple()] -%% @end -%%-------------------------------------------------------------------- -m1() -> - []. + [macros_defined, macros_undefined]. %%-------------------------------------------------------------------- %% @spec TestCase(Config0) -> @@ -149,19 +141,29 @@ m1() -> %% Comment = term() %% @end %%-------------------------------------------------------------------- -m1(Config) -> - {Src,Dst} = convert_module("m1",Config), +macros_defined(Config) -> + %% let erl2html2 use epp as parser + DataDir = ?config(data_dir,Config), + InclDir = filename:join(DataDir, "include"), + {Src,Dst} = convert_module("m1",[InclDir],Config), {true,L} = check_line_numbers(Src,Dst), - ok = check_link_targets(Src,Dst,L,[{baz,0}]), + ok = check_link_targets(Src,Dst,L,[{baz,0}],[]), ok. -convert_module(Mod,Config) -> +macros_undefined(Config) -> + %% let erl2html2 use epp_dodger as parser + {Src,Dst} = convert_module("m1",[],Config), + {true,L} = check_line_numbers(Src,Dst), + ok = check_link_targets(Src,Dst,L,[{baz,0}],[{quux,0}]), + ok. + +convert_module(Mod,InclDirs,Config) -> DataDir = ?config(data_dir,Config), PrivDir = ?config(priv_dir,Config), Src = filename:join(DataDir,Mod++".erl"), Dst = filename:join(PrivDir,Mod++".erl.html"), io:format("<a href=\"~s\">~s</a>\n",[Src,filename:basename(Src)]), - ok = erl2html2:convert(Src, Dst, [], "<html><body>"), + ok = erl2html2:convert(Src, Dst, InclDirs, "<html><body>"), io:format("<a href=\"~s\">~s</a>\n",[Dst,filename:basename(Dst)]), {Src,Dst}. @@ -229,36 +231,46 @@ check_line_number(Last,Line,OrigLine) -> %% function. %% The test module has -compile(export_all), so all functions are %% found by listing the exported ones. -check_link_targets(Src,Dst,L,RmFncs) -> +check_link_targets(Src,Dst,L,RmFncs,ShouldRemain) -> Mod = list_to_atom(filename:basename(filename:rootname(Src))), Exports = Mod:module_info(exports)--[{module_info,0},{module_info,1}|RmFncs], - {ok,{[],L},_} = xmerl_sax_parser:file(Dst, - [{event_fun,fun sax_event/3}, - {event_state,{Exports,0}}]), + LastExprFuncs = [Func || {Func,_A} <- Exports], + {ok,{FAs,Fs,L},_} = + xmerl_sax_parser:file(Dst, + [{event_fun,fun sax_event/3}, + {event_state,{Exports,LastExprFuncs,0}}]), + true = (length(FAs) == length(ShouldRemain)), + [] = [FA || FA <- FAs, not lists:member(FA,ShouldRemain)], + [] = [F || F <- Fs, not lists:keymember(F,1,ShouldRemain)], ok. sax_event(Event,_Loc,State) -> sax_event(Event,State). -sax_event({startElement,_Uri,"a",_QN,Attrs},{Exports,PrevLine}) -> +sax_event({startElement,_Uri,"a",_QN,Attrs},{Exports,LastExprFuncs,PrevLine}) -> {_,_,"name",Name} = lists:keyfind("name",3,Attrs), case catch list_to_integer(Name) of Line when is_integer(Line) -> case PrevLine + 1 of Line -> -% erlang:display({found_line,Line}), - {Exports,Line}; + {Exports,LastExprFuncs,Line}; Other -> ct:fail({unexpected_line_number_target,Other}) end; {'EXIT',_} -> - {match,[FStr,AStr]} = - re:run(Name,"^(.*)-([0-9]+)$",[{capture,all_but_first,list}]), + {match,[FStr,EndStr]} = + re:run(Name,"^(.*)-(last_expr|[0-9]+)$", + [{capture,all_but_first,list}]), F = list_to_atom(http_uri:decode(FStr)), - A = list_to_integer(AStr), -% erlang:display({found_fnc,F,A}), - A = proplists:get_value(F,Exports), - {lists:delete({F,A},Exports),PrevLine} + case EndStr of + "last_expr" -> + true = lists:member(F,LastExprFuncs), + {Exports,lists:delete(F,LastExprFuncs),PrevLine}; + _ -> + A = list_to_integer(EndStr), + A = proplists:get_value(F,Exports), + {lists:delete({F,A},Exports),LastExprFuncs,PrevLine} + end end; sax_event(_,State) -> State. diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl b/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl new file mode 100644 index 0000000000..2a20850a3a --- /dev/null +++ b/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl @@ -0,0 +1 @@ +-define(EPP_SWITCH, on). diff --git a/lib/test_server/test/erl2html2_SUITE_data/m1.erl b/lib/test_server/test/erl2html2_SUITE_data/m1.erl index 156f1d0a51..1d405963a5 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/m1.erl +++ b/lib/test_server/test/erl2html2_SUITE_data/m1.erl @@ -7,9 +7,15 @@ -include("header1.hrl"). -include("header2.hrl"). +-include("header3.hrl"). -define(MACRO1,value). +%% This macro is used to select parser in erl2html2. +%% If EPP_SWITCH is defined epp is used, else epp_dodger. +epp_switch() -> + ?EPP_SWITCH. + %%% Comment foo(x) -> %% Comment diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index 2a2ed2b3b0..fd9e4e6d74 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.8.1 +TEST_SERVER_VSN = 3.9 diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index cbad05081e..f8070e04c1 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -931,7 +931,9 @@ analyze_one_function({Var, FunBody} = Function, Acc) -> A = cerl:fname_arity(Var), TmpDialyzerObj = {{Acc#tmpAcc.module, F, A}, Function}, NewDialyzerObj = Acc#tmpAcc.dialyzerObj ++ [TmpDialyzerObj], - [_, LineNo, {file, FileName}] = cerl:get_ann(FunBody), + Anno = cerl:get_ann(FunBody), + LineNo = get_line(Anno), + FileName = get_file(Anno), BaseName = filename:basename(FileName), FuncInfo = {LineNo, F, A}, OriginalName = Acc#tmpAcc.file, @@ -951,6 +953,14 @@ analyze_one_function({Var, FunBody} = Function, Acc) -> incFuncAcc = IncFuncAcc, dialyzerObj = NewDialyzerObj}. +get_line([Line|_]) when is_integer(Line) -> Line; +get_line([_|T]) -> get_line(T); +get_line([]) -> none. + +get_file([{file,File}|_]) -> File; +get_file([_|T]) -> get_file(T); +get_file([]) -> "no_file". % should not happen + -spec get_dialyzer_plt(analysis()) -> plt(). get_dialyzer_plt(#analysis{plt = PltFile0}) -> diff --git a/lib/webtool/vsn.mk b/lib/webtool/vsn.mk index a79c273d9f..4a701ae6e0 100644 --- a/lib/webtool/vsn.mk +++ b/lib/webtool/vsn.mk @@ -1 +1 @@ -WEBTOOL_VSN=0.8.10 +WEBTOOL_VSN=0.9 diff --git a/otp_versions.table b/otp_versions.table index 12790c88a8..fbed2ce427 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-17.5.4 : inets-5.10.8 ssh-3.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 dialyzer-2.7.4 diameter-1.9.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 jinterface-1.5.12 kernel-3.2 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 sasl-2.4.1 snmp-5.1.2 ssl-6.0 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.3 : common_test-1.10.1 diameter-1.9.1 erts-6.4.1 snmp-5.1.2 test_server-3.8.1 # asn1-3.0.4 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 dialyzer-2.7.4 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.7 jinterface-1.5.12 kernel-3.2 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 sasl-2.4.1 ssh-3.2.2 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.2 : inets-5.10.7 ssh-3.2.2 # asn1-3.0.4 common_test-1.10 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 dialyzer-2.7.4 diameter-1.9 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 jinterface-1.5.12 kernel-3.2 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 sasl-2.4.1 snmp-5.1.1 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.1 : ssh-3.2.1 # asn1-3.0.4 common_test-1.10 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 dialyzer-2.7.4 diameter-1.9 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.6 jinterface-1.5.12 kernel-3.2 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 sasl-2.4.1 snmp-5.1.1 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8 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/modules.xml b/system/doc/reference_manual/modules.xml index 39c739a146..d283c33910 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -246,7 +246,8 @@ behaviour_info(callbacks) -> Callbacks.</pre> a list of <c>{Key,Value}</c> tuples with information about the module. Currently, the list contain tuples with the following <c>Key</c>s: <c>module</c>, <c>attributes</c>, <c>compile</c>, - <c>exports</c> and <c>md5</c>. The order and number of tuples + <c>exports</c>, <c>md5</c> and <c>native</c>. + The order and number of tuples may change without prior notice.</p> </section> @@ -288,7 +289,9 @@ behaviour_info(callbacks) -> Callbacks.</pre> <tag><c>md5</c></tag> <item> - <p>Returns a binary representing the MD5 checksum of the module.</p> + <p>Returns a binary representing the MD5 checksum of the module. + If the module has native code loaded, this will be the MD5 of the + native code, not the BEAM bytecode.</p> </item> <tag><c>exports</c></tag> @@ -302,6 +305,13 @@ behaviour_info(callbacks) -> Callbacks.</pre> <p>Returns a list of <c>{Name,Arity}</c> tuples with all functions in the module.</p> </item> + + <tag><c>native</c></tag> + <item> + <p>Return <c>true</c> if the module has native compiled code. + Return <c>false</c> otherwise. In a system compiled without HiPE + support, the result is always <c>false</c></p> + </item> </taglist> </section> </section> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index 53ef93b60f..0dca743ab3 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -232,6 +232,9 @@ <cell><c>arity()</c></cell><cell><c>0..255</c></cell> </row> <row> + <cell><c>identifier()</c></cell><cell><c>pid() | port() | reference()</c></cell> + </row> + <row> <cell><c>node()</c></cell><cell><c>atom()</c></cell> </row> <row> |