diff options
487 files changed, 21058 insertions, 10232 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex d245ea522b..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 d245ea522b..c4244d91e4 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 7ddcb3a37e..4e31355235 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex 7d7ade33f6..6fc683bf76 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 89867ee4a3..ccab57cc81 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam Binary files differindex 662edc0651..4d8f94c4ea 100644 --- a/bootstrap/lib/compiler/ebin/beam_listing.beam +++ b/bootstrap/lib/compiler/ebin/beam_listing.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex b844602370..6878a8a01c 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex d3d9440248..fc2e1b6c78 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex a5efd6530c..38b749d9ae 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex a089535e59..0e466ad38e 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 8dd26f307b..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/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex f0e746cbd0..025ac1591b 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 30445f234a..2ed29957b3 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex f7621bbc3f..a1c6466ccd 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex f727e5c1b9..6eba755081 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 93ecf832bb..7b33f9cbff 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 64f68bcfb4..e4c5f51f77 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex b0b9e3d12c..6f68b83ad5 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 02f6c1bbbb..9a7907cb38 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex 93bf7ad032..9a644b6b48 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex 3ccdfaea05..287a8c0de8 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex 7027118b3f..ea948cfe88 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 1acdba0178..f162729d6a 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 2fb529adb4..158fbd1c93 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.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/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/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex e38c4baa31..caeda89fa5 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex c21b663e20..54cf78d6ce 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 463e571164..abf4949465 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 04dde86c0d..100996bf85 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 9d543abc94..711ca0b9f0 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex f4ede5d16a..4d052a0c50 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex a7dad32572..00cf6f2a5c 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam Binary files differnew file mode 100644 index 0000000000..f30442bc06 --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 1b5a6d2ede..2354a065ca 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex cab9c9bdbf..db2d0e6b85 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 606666808d..7c80cbe624 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 373eaef459..adf1cfb43e 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 12755c710e..f38ba5fa71 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex f90464d278..c29200f2e0 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 83a6a5cdb2..e923cecea8 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam 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/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex d7d25774f4..bc3e71f6a7 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex d04466bf92..268b8798c8 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 11487e747c..1e1e530eea 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 46e5ac610a..cc8503fdb3 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex d978382590..38a30aed66 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 5dfd03d3b7..652604afc0 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex e9c359400b..0e59d769a4 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differnew file mode 100644 index 0000000000..b6e0d20bd7 --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex c0450dab5b..3b2d0eb0fa 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 9d83483669..50eb39d712 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 +39,7 @@ edlin_expand, epp, eval_bits, + erl_anno, erl_bits, erl_compile, erl_eval, @@ -83,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/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 35625e99d5..ec0c45c134 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex d4b8cab555..1ebc561ee5 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam Binary files differindex 8f34d08a0b..9887f37c70 100644 --- a/bootstrap/lib/stdlib/ebin/timer.beam +++ b/bootstrap/lib/stdlib/ebin/timer.beam diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 83f735d332..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)]) @@ -559,7 +558,7 @@ dnl AC_DEFUN(LM_SYS_MULTICAST, [AC_CACHE_CHECK([for multicast support], ac_cv_sys_multicast_support, -[AC_EGREP_CPP(yes, +[AC_EGREP_CPP(^yes$, [#include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> @@ -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 795ce0639b..4c0d981df1 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)])) @@ -1558,10 +1549,11 @@ if test "$have_gethostbyname_r" = yes; then [Define to flavour of gethostbyname_r])) ;; *) - AC_EGREP_CPP(yes,[#include <stdio.h> - #ifdef __GLIBC__ - yes - #endif + AC_EGREP_CPP(^yes$,[ +#include <stdio.h> +#ifdef __GLIBC__ +yes +#endif ], AC_DEFINE(HAVE_GETHOSTBYNAME_R, GHBN_R_GLIBC, [Define to flavour of gethostbyname_r])) ;; @@ -4297,10 +4289,10 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_INCLUDE="-I$dir/include" old_CPPFLAGS=$CPPFLAGS CPPFLAGS=$SSL_INCLUDE - AC_EGREP_CPP(yes,[ + AC_EGREP_CPP(^yes$,[ #include <openssl/opensslv.h> #if OPENSSL_VERSION_NUMBER >= 0x0090700fL - yes +yes #endif ],[ ssl_found=yes @@ -4495,10 +4487,10 @@ if test "x$SSL_APP" != "x" ; then AC_MSG_CHECKING(for OpenSSL kerberos 5 support) old_CPPFLAGS=$CPPFLAGS CPPFLAGS=$SSL_INCLUDE - AC_EGREP_CPP(yes,[ + AC_EGREP_CPP(^yes$,[ #include <openssl/opensslconf.h> #ifndef OPENSSL_NO_KRB5 - yes +yes #endif ],[ AC_MSG_RESULT([yes]) @@ -4737,12 +4729,12 @@ fi AC_CHECK_PROGS(JAVAC, $check_javac) if test -n "$JAVAC"; then - dnl Make sure it's at least JDK 1.5 - AC_CACHE_CHECK(for JDK version 1.5, - ac_cv_prog_javac_ver_1_5, + dnl Make sure it's at least JDK 1.6 + AC_CACHE_CHECK(for JDK version 1.6, + ac_cv_prog_javac_ver_1_6, [ERL_TRY_LINK_JAVA([], [for (String i : args);], - ac_cv_prog_javac_ver_1_5=yes, ac_cv_prog_javac_ver_1_5=no)]) - if test $ac_cv_prog_javac_ver_1_5 = no; then + ac_cv_prog_javac_ver_1_6=yes, ac_cv_prog_javac_ver_1_6=no)]) + if test $ac_cv_prog_javac_ver_1_6 = no; then unset -v JAVAC fi fi diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index a2b4ae49a4..35e6e55e72 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,22 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 6.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The VTS mode in Common Test has been modified to use a + private version of the Webtool application (ct_webtool).</p> + <p> + Own Id: OTP-12704 Aux Id: OTP-10922 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 6.4</title> <section><title>Fixed Bugs and Malfunctions</title> 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 fce4fd498a..9fe02c3724 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -562,7 +562,8 @@ void** beam_ops; Store(term, Dst); \ } while (0) -#define Move2(src1, dst1, src2, dst2) dst1 = (src1); dst2 = (src2) +#define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2) +#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) #define MoveGenDest(src, dstp) \ if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; } @@ -662,6 +663,9 @@ void** beam_ops; #define EqualImmed(X, Y, Action) if (X != Y) { Action; } #define NotEqualImmed(X, Y, Action) if (X == Y) { Action; } +#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; } +#define IsLessThan(X, Y, Action) if (CMP_GE(X, Y)) { Action; } +#define IsGreaterEqual(X, Y, Action) if (CMP_LT(X, Y)) { Action; } #define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } @@ -1389,7 +1393,39 @@ void process_main(void) ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); goto find_func_info; } - + +#define DO_BIG_ARITH(Func,Arg1,Arg2) \ + do { \ + Uint live = Arg(1); \ + SWAPOUT; \ + reg[0] = r(0); \ + reg[live] = (Arg1); \ + reg[live+1] = (Arg2); \ + result = (Func)(c_p, reg, live); \ + r(0) = reg[0]; \ + SWAPIN; \ + ERTS_HOLE_CHECK(c_p); \ + if (is_value(result)) { \ + StoreBifResult(4,result); \ + } \ + goto lb_Cl_error; \ + } while(0) + + OpCase(i_plus_jIxxd): + { + Eterm result; + + if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { + Sint i = signed_val(xb(Arg(2))) + signed_val(xb(Arg(3))); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + result = make_small(i); + StoreBifResult(4, result); + } + } + DO_BIG_ARITH(ARITH_FUNC(mixed_plus), xb(Arg(2)), xb(Arg(3))); + } + OpCase(i_plus_jId): { Eterm result; @@ -1401,12 +1437,26 @@ void process_main(void) result = make_small(i); STORE_ARITH_RESULT(result); } - } arith_func = ARITH_FUNC(mixed_plus); goto do_big_arith2; } + OpCase(i_minus_jIxxd): + { + Eterm result; + + if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { + Sint i = signed_val(xb(Arg(2))) - signed_val(xb(Arg(3))); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + result = make_small(i); + StoreBifResult(4, result); + } + } + DO_BIG_ARITH(ARITH_FUNC(mixed_minus), xb(Arg(2)), xb(Arg(3))); + } + OpCase(i_minus_jId): { Eterm result; @@ -1499,6 +1549,52 @@ void process_main(void) Next(2); } + OpCase(move_window3_xxxy): { + BeamInstr *next; + Eterm xt0, xt1, xt2; + Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(3))); + PreFetch(4, next); + xt0 = xb(Arg(0)); + xt1 = xb(Arg(1)); + xt2 = xb(Arg(2)); + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; + NextPF(4, next); + } + OpCase(move_window4_xxxxy): { + BeamInstr *next; + Eterm xt0, xt1, xt2, xt3; + Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(4))); + PreFetch(5, next); + xt0 = xb(Arg(0)); + xt1 = xb(Arg(1)); + xt2 = xb(Arg(2)); + xt3 = xb(Arg(3)); + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; + y[3] = xt3; + NextPF(5, next); + } + OpCase(move_window5_xxxxxy): { + BeamInstr *next; + Eterm xt0, xt1, xt2, xt3, xt4; + Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(5))); + PreFetch(6, next); + xt0 = xb(Arg(0)); + xt1 = xb(Arg(1)); + xt2 = xb(Arg(2)); + xt3 = xb(Arg(3)); + xt4 = xb(Arg(4)); + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; + y[3] = xt3; + y[4] = xt4; + NextPF(6, next); + } + OpCase(i_move_call_only_fcr): { r(0) = Arg(1); } @@ -2023,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; + } } } @@ -2109,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; } @@ -2835,6 +2919,19 @@ do { \ goto do_big_arith2; } + OpCase(i_rem_jIxxd): + { + Eterm result; + + if (xb(Arg(3)) == SMALL_ZERO) { + goto badarith; + } else if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { + result = make_small(signed_val(xb(Arg(2))) % signed_val(xb(Arg(3)))); + StoreBifResult(4, result); + } + DO_BIG_ARITH(ARITH_FUNC(int_rem),xb(Arg(2)),xb(Arg(3))); + } + OpCase(i_rem_jId): { Eterm result; @@ -2850,6 +2947,20 @@ do { \ } } + OpCase(i_band_jIxcd): + { + Eterm result; + + if (is_both_small(xb(Arg(2)), Arg(3))) { + /* + * No need to untag -- TAG & TAG == TAG. + */ + result = xb(Arg(2)) & Arg(3); + StoreBifResult(4, result); + } + DO_BIG_ARITH(ARITH_FUNC(band),xb(Arg(2)),Arg(3)); + } + OpCase(i_band_jId): { Eterm result; @@ -2865,6 +2976,8 @@ do { \ goto do_big_arith2; } +#undef DO_BIG_ARITH + do_big_arith2: { Eterm result; @@ -5821,7 +5934,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 8d7beb4eb4..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); @@ -3172,7 +3173,11 @@ gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOpArg Integer, static int negation_is_small(LoaderState* stp, GenOpArg Int) { - return Int.type == TAG_i && IS_SSMALL(-Int.val); + /* Check for the rare case of overflow in BeamInstr (UWord) -> Sint + * Cast to the correct type before using IS_SSMALL (Sint) */ + return Int.type == TAG_i && + !(Int.val & ~((((BeamInstr)1) << ((sizeof(Sint)*8)-1))-1)) && + IS_SSMALL(-((Sint)Int.val)); } @@ -5404,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); @@ -5429,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; } @@ -5489,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},...] * @@ -5691,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; } @@ -6164,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; @@ -6192,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; } @@ -6247,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; @@ -6353,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/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index e396395dde..b832626e7b 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 @@ -3186,7 +3195,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 +3269,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 e2f8da38b9..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 @@ -419,7 +419,12 @@ type ENVIRONMENT TEMPORARY SYSTEM environment type PUTENV_STR SYSTEM SYSTEM putenv_string type PRT_REP_EXIT STANDARD SYSTEM port_report_exit type SYS_BLOCKING STANDARD SYSTEM sys_blocking + ++if smp type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf ++else +type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf ++endif +endif diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index 5150a8a507..47d516534f 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -2048,3 +2048,8 @@ Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live) } return result; } + +/* Needed to remove compiler optimization */ +double erts_get_positive_zero_float() { + return 0.0f; +} 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_bits.c b/erts/emulator/beam/erl_bits.c index 5cc0a23dc9..b8ae93fa58 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -165,6 +165,26 @@ erts_bs_start_match_2(Process *p, Eterm Binary, Uint Max) return make_matchstate(ms); } +#ifdef DEBUG +# define CHECK_MATCH_BUFFER(MB) check_match_buffer(MB) + +static void check_match_buffer(ErlBinMatchBuffer* mb) +{ + Eterm realbin; + Uint byteoffs; + byte* bytes, bitoffs, bitsz; + ProcBin* pb; + ERTS_GET_REAL_BIN(mb->orig, realbin, byteoffs, bitoffs, bitsz); + bytes = binary_bytes(realbin) + byteoffs; + ERTS_ASSERT(mb->base >= bytes && mb->base <= (bytes + binary_size(mb->orig))); + pb = (ProcBin *) boxed_val(realbin); + if (pb->thing_word == HEADER_PROC_BIN) + ERTS_ASSERT(pb->flags == 0); +} +#else +# define CHECK_MATCH_BUFFER(MB) +#endif + Eterm erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) { @@ -185,6 +205,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff return SMALL_ZERO; } + CHECK_MATCH_BUFFER(mb); if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ return THE_NON_VALUE; } @@ -425,6 +446,7 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe { ErlSubBin* sb; + CHECK_MATCH_BUFFER(mb); if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ return THE_NON_VALUE; } @@ -456,6 +478,7 @@ erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer byte* fptr; FloatDef f; + CHECK_MATCH_BUFFER(mb); if (num_bits == 0) { f.fd = 0.0; hp = HeapOnlyAlloc(p, FLOAT_SIZE_OBJECT); @@ -509,6 +532,8 @@ erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb) { ErlSubBin* sb; Uint size; + + CHECK_MATCH_BUFFER(mb); size = mb->size-mb->offset; sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE); sb->thing_word = HEADER_SUB_BIN; @@ -1595,6 +1620,7 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb) byte* LSB; byte* MSB; + CHECK_MATCH_BUFFER(mb); ASSERT((mb->offset & 7) != 0); ASSERT(mb->size - mb->offset >= 32); @@ -1654,6 +1680,8 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,9,9,9,9,9,9,9,9 }; + CHECK_MATCH_BUFFER(mb); + if ((remaining_bits = mb->size - mb->offset) < 8) { return THE_NON_VALUE; } @@ -1738,6 +1766,7 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags) return THE_NON_VALUE; } + CHECK_MATCH_BUFFER(mb); /* * Set up the pointer to the source bytes. */ 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_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..cf92ded415 --- /dev/null +++ b/erts/emulator/beam/erl_hl_timer.c @@ -0,0 +1,2884 @@ +/* + * %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 (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + 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... + */ + if (tmr->btm.bp) { + free_message_buffer(tmr->btm.bp); + tmr->btm.bp = NULL; + } + 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 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); + 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); + } +} + +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) { + 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; + + 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)) + hsz += REF_THING_SIZE; + hsz += 1; /* upgrade to 3-tuple */ + } + if (time_left > (Sint64) MAX_SMALL) + hsz += ERTS_SINT64_HEAP_SIZE(time_left); + + 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)) + 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; + ErlOffHeap *ohp; + ErlHeapFragment* bp; + 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 = erts_alloc_message_heap(hsz, + &bp, + &ohp, + c_p, + &proc_locks); + 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, bp, 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 = 0; + 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) + hlt_delete_timer(esdp, tmr); + hl_timer_dec_refc(tmr, roflgs); + } + else { + if (state == ERTS_TMR_STATE_ACTIVE) + 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, tres < 0 ? BADARG : SYSTEM_LIMIT); + + 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, tres < 0 ? BADARG : SYSTEM_LIMIT); + + 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, tres < 0 ? BADARG : SYSTEM_LIMIT); + + 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, tres < 0 ? BADARG : SYSTEM_LIMIT); + + 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_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 40b043d1cc..340c7033ab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -867,6 +867,9 @@ void print_process_info(int, void *, Process*); void info(int, void *); void loaded(int, void *); +/* erl_arith.c */ +double erts_get_positive_zero_float(void); + /* config.c */ __decl_noreturn void __noreturn erl_exit(int n, char*, ...); @@ -1306,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 @@ -1328,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/ops.tab b/erts/emulator/beam/ops.tab index 9bdc9cb88d..ece038131e 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -298,10 +298,49 @@ move_jump f c move_jump f x move_jump f y + +# Movement to and from the stack is common +# Try to pack as much as we can into one instruction + +# Window move +move_window/5 +move_window/6 + +# x -> y + +move S1=r S2=y | move X1=x Y1=y => move2 S1 S2 X1 Y1 + +move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y | succ(Y1,Y2) | succ(Y2,Y3) => \ + move_window X1 X2 X3 Y1 Y3 + +move_window X1=x X2=x X3=x Y1=y Y3=y | move X4=x Y4=y | succ(Y3,Y4) => \ + move_window X1 X2 X3 X4 Y1 Y4 + +move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \ + move_window5 X1 X2 X3 X4 X5 Y1 + +move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1 +move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1 + +move_window3 x x x y +move_window4 x x x x y +move_window5 x x x x x y + move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2 move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4 +move S1=x S2=r | move S3=x S4=x => move2 S1 S2 S3 S4 +move S1=x S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1 +move S1=y S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1 + +move Y1=y X1=x | move S1=r D1=x => move2 Y1 X1 S1 D1 +move S1=r D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1 + +move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3 +move2 Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3 +move2 X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6 + move C=aiq X=x==1 => move_x1 C move C=aiq X=x==2 => move_x2 C @@ -313,6 +352,20 @@ move2 x y x y move2 y x y x move2 x x x x +move2 x r x x + +move2 x r x y +move2 r y x y +move2 y r x y + +move2 r x y x +move2 y x r x + +%macro: move3 Move3 +move3 x y x y x y +move3 y x y x y x +move3 x x x x x x + # The compiler almost never generates a "move Literal y(Y)" instruction, # so let's cheat if we encounter one. move S=n D=y => init D @@ -392,14 +445,59 @@ i_is_ne_exact_literal x f c i_is_ne_exact_literal y f c # +# Common Compare Specializations +# We don't do all of them since we want +# to keep the instruction set small-ish +# + +is_eq_exact Lbl S1=xy S2=r => is_eq_exact Lbl S2 S1 +is_eq_exact Lbl S1=rx S2=xy => i_is_eq_exact_spec Lbl S1 S2 +%macro: i_is_eq_exact_spec EqualExact -fail_action + +i_is_eq_exact_spec f x x +i_is_eq_exact_spec f x y +i_is_eq_exact_spec f r x +i_is_eq_exact_spec f r y +%cold +i_is_eq_exact_spec f r r +%hot + +is_lt Lbl S1=rxc S2=rxc => i_is_lt_spec Lbl S1 S2 + +%macro: i_is_lt_spec IsLessThan -fail_action + +i_is_lt_spec f x x +i_is_lt_spec f x r +i_is_lt_spec f x c +i_is_lt_spec f r x +i_is_lt_spec f r c +i_is_lt_spec f c x +i_is_lt_spec f c r +%cold +i_is_lt_spec f r r +i_is_lt_spec f c c +%hot + +is_ge Lbl S1=xc S2=xc => i_is_ge_spec Lbl S1 S2 + +%macro: i_is_ge_spec IsGreaterEqual -fail_action + +i_is_ge_spec f x x +i_is_ge_spec f x c +i_is_ge_spec f c x +%cold +i_is_ge_spec f c c +%hot + +# # All other comparisons. # is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl -is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl +is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl @@ -493,7 +591,6 @@ put_list s s d %hot %macro: i_fetch FetchArgs -pack -i_fetch c c i_fetch c r i_fetch c x i_fetch c y @@ -510,6 +607,7 @@ i_fetch y x i_fetch y y %cold +i_fetch c c i_fetch s s %hot @@ -1562,17 +1660,21 @@ gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \ # GCing arithmetic instructions. # +gc_bif2 Fail I u$bif:erlang:splus/2 S1=x S2=x Dst=d => i_plus Fail I S1 S2 Dst gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst +gc_bif2 Fail I u$bif:erlang:sminus/2 S1=x S2=x Dst=d => i_minus Fail I S1 S2 Dst gc_bif2 Fail I u$bif:erlang:sminus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_minus Fail I Dst gc_bif2 Fail I u$bif:erlang:stimes/2 S1 S2 Dst=d => i_fetch S1 S2 | i_times Fail I Dst gc_bif2 Fail I u$bif:erlang:div/2 S1 S2 Dst=d => i_fetch S1 S2 | i_m_div Fail I Dst gc_bif2 Fail I u$bif:erlang:intdiv/2 S1 S2 Dst=d => i_fetch S1 S2 | i_int_div Fail I Dst +gc_bif2 Fail I u$bif:erlang:rem/2 S1=x S2=x Dst=d => i_rem Fail I S1 S2 Dst gc_bif2 Fail I u$bif:erlang:rem/2 S1 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I Dst gc_bif2 Fail I u$bif:erlang:bsl/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsl Fail I Dst gc_bif2 Fail I u$bif:erlang:bsr/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsr Fail I Dst +gc_bif2 Fail I u$bif:erlang:band/2 S1=x S2=c Dst=d => i_band Fail I S1 S2 Dst gc_bif2 Fail I u$bif:erlang:band/2 S1 S2 Dst=d => i_fetch S1 S2 | i_band Fail I Dst gc_bif2 Fail I u$bif:erlang:bor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bor Fail I Dst gc_bif2 Fail I u$bif:erlang:bxor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bxor Fail I Dst @@ -1586,16 +1688,20 @@ i_increment r I I d i_increment x I I d i_increment y I I d +i_plus j I x x d i_plus j I d +i_minus j I x x d i_minus j I d i_times j I d i_m_div j I d i_int_div j I d +i_rem j I x x d i_rem j I d i_bsl j I d i_bsr j I d +i_band j I x c d i_band j I d i_bor j I d i_bxor j I d 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..54059ee9a5 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -703,14 +703,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 +724,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 +776,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 +817,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..ea19d8b362 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,54 +119,22 @@ 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 */ @@ -167,35 +144,23 @@ find_next_timeout(ErtsTimerWheel *tiw, ErtsMonotonicTime max_search_time) { int start_ix, tiw_pos_ix; - ErlTimer *p; + ErtsTWheelTimer *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)); + ErtsMonotonicTime min_timeout, min_timeout_pos, slot_timeout_pos; 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; - 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); + true_min_timeout = 0; + min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time + 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); - 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++; @@ -206,77 +171,125 @@ find_next_timeout(ErtsTimerWheel *tiw, 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); - /* last */ - if (!p->next) { + 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); + + 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->slot = ERTS_TWHEEL_SLOT_INACTIVE; + +#if 0 p->next = NULL; p->prev = NULL; +#endif - 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; + /* + * Called before a scheduler is about to wait. We wont + * check more than 10 minutes into the future. + */ + return find_next_timeout(esdp->timer_wheel, + erts_get_monotonic_time(esdp), + ERTS_SEC_TO_MONOTONIC(10*60)); } -#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 +297,255 @@ 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; +#if 0 + p->next = NULL; + p->prev = NULL; +#endif + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; + timeout = p->u.func.timeout; + arg = p->u.func.arg; + (*timeout)(arg); +} + 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; + int tiw_pos_ix, slots, yielded_slot_restarted, yield_count; + ErtsMonotonicTime bump_to, tmp_slots, old_pos; - if (erts_smp_atomic32_cmpxchg_nob(&tiw->is_bumping, 1, 0) != 0) - return; /* Another thread is currently bumping... */ + yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; - bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); - - 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 { + + yielded_slot_restarted = 0; - 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; - } + bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); - if (tiw->nto == 0) { - ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, bump_to); - tiw->pos = bump_to; - goto done; - } + while (1) { + ErtsTWheelTimer *p; - if (tiw->true_next_timeout_time) { - ErtsMonotonicTime skip_until_pos; - /* - * No need inspecting slots where we know no timeouts - * to trigger should reside. - */ + old_pos = tiw->pos; + + 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; + } - skip_until_pos = ERTS_MONOTONIC_TO_CLKTCKS(tiw->next_timeout_time); - if (skip_until_pos > bump_to) - skip_until_pos = bump_to; + 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; + } - ERTS_DBG_CHK_SAFE_TO_SKIP_TO(tiw, skip_until_pos); - ASSERT(skip_until_pos > tiw->pos); + if (tiw->pos >= bump_to) + break; - tiw->pos = skip_until_pos - 1; - } + if (tiw->nto == 0) + goto empty_wheel; - 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; + if (tiw->true_next_timeout_time) { + ErtsMonotonicTime skip_until_pos; + /* + * No need inspecting slots where we know no timeouts + * to trigger should reside. + */ + + skip_until_pos = ERTS_MONOTONIC_TO_CLKTCKS(tiw->next_timeout_time); + if (skip_until_pos > bump_to) + skip_until_pos = bump_to; + + skip_until_pos--; + + 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--; } - 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))); + } while (yielded_slot_restarted); - tiw->pos = bump_to; + 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(tiw, curr_time, ERTS_SEC_TO_MONOTONIC(2)); - -done: - - erts_smp_mtx_unlock(&tiw->lock); - - erts_smp_atomic32_set_nob(&tiw->is_bumping, 0); - - /* 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); - } } 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 +566,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 +655,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 +664,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 8f6335d5dd..e21e916de5 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 @@ -958,7 +960,8 @@ tail_recur: FloatDef ff; GET_DOUBLE(term, ff); if (ff.fd == 0.0f) { - ff.fd = 0.0f; /* ensure pos. 0.0 */ + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); } hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); break; @@ -1477,7 +1480,8 @@ make_hash2(Eterm term) FloatDef ff; GET_DOUBLE(term, ff); if (ff.fd == 0.0f) { - ff.fd = 0.0f; /* ensure pos. 0.0 */ + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); } #if defined(WORDS_BIGENDIAN) || defined(DOUBLE_MIDDLE_ENDIAN) UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12); @@ -1899,7 +1903,8 @@ make_internal_hash(Eterm term) FloatDef ff; GET_DOUBLE(term, ff); if (ff.fd == 0.0f) { - ff.fd = 0.0f; /* ensure pos. 0.0 */ + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); } UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12); goto pop_next; @@ -2087,7 +2092,8 @@ tail_recur: FloatDef ff; GET_DOUBLE(term, ff); if (ff.fd == 0.0f) { - ff.fd = 0.0f; /* ensure pos. 0.0 */ + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); } hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); } @@ -4437,145 +4443,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; @@ -4585,9 +4452,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/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 7d94aa05b3..74cb9112ce 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -159,37 +159,36 @@ define(standard_bif_interface_4, ` #ifndef HAVE_$1 #`define' HAVE_$1 - TEXT - .align 4 - GLOBAL(ASYM($1)) + TEXT + .align 4 + GLOBAL(ASYM($1)) ASYM($1): - /* set up the parameters */ - movq P, %rdi - NBIF_ARG(%rsi,4,0) - NBIF_ARG(%rdx,4,1) - NBIF_ARG(%rcx,4,2) - NBIF_ARG(%r8,4,3) - - /* make the call on the C stack */ - SWITCH_ERLANG_TO_C - pushq %r8 - pushq %rcx - pushq %rdx - pushq %rsi - movq %rsp, %rsi /* Eterm* BIF__ARGS */ - sub $(8), %rsp /* stack frame 16-byte alignment */ - CALL_BIF($2) - add $(4*8 + 8), %rsp - TEST_GOT_MBUF - SWITCH_C_TO_ERLANG - - /* throw exception if failure, otherwise return */ - TEST_GOT_EXN - jz nbif_4_simple_exception - NBIF_RET(4) - HANDLE_GOT_MBUF(4) - SET_SIZE(ASYM($1)) - TYPE_FUNCTION(ASYM($1)) + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,4,0) + NBIF_ARG(%rdx,4,1) + NBIF_ARG(%rcx,4,2) + NBIF_ARG(%r8,4,3) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + pushq %r8 + pushq %rcx + pushq %rdx + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + CALL_BIF($2) + add $(4*8), %rsp + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_4_simple_exception + NBIF_RET(4) + HANDLE_GOT_MBUF(4) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) #endif') define(standard_bif_interface_0, diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 index b2e3f83d1e..ca6aef2f8d 100644 --- a/erts/emulator/hipe/hipe_arm_asm.m4 +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -163,6 +163,10 @@ define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_ST `/* #define NBIF_ARG_3_0 'NBIF_ARG(r1,3,0)` */' `/* #define NBIF_ARG_3_1 'NBIF_ARG(r2,3,1)` */' `/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */' +`/* #define NBIF_ARG_4_0 'NBIF_ARG(r1,4,0)` */' +`/* #define NBIF_ARG_4_1 'NBIF_ARG(r2,4,1)` */' +`/* #define NBIF_ARG_4_2 'NBIF_ARG(r3,4,2)` */' +`/* #define NBIF_ARG_4_3 'NBIF_ARG(r4,4,3)` */' `/* #define NBIF_ARG_5_0 'NBIF_ARG(r1,5,0)` */' `/* #define NBIF_ARG_5_1 'NBIF_ARG(r2,5,1)` */' `/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */' @@ -186,6 +190,7 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl `/* #define NBIF_RET_1 'NBIF_RET(1)` */' `/* #define NBIF_RET_2 'NBIF_RET(2)` */' `/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_4 'NBIF_RET(4)` */' `/* #define NBIF_RET_5 'NBIF_RET(5)` */' dnl diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 884240be9c..6abc7545e0 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -42,9 +42,10 @@ define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */ * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_4(nbif_name, cbif_name) * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-4 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -134,6 +135,39 @@ $1: .type $1, %function #endif') +define(standard_bif_interface_4, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,4,0) + NBIF_ARG(r2,4,1) + NBIF_ARG(r3,4,2) + NBIF_ARG(r4,4,3) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + str r2, [r0, #P_ARG1] + str r3, [r0, #P_ARG2] + str r4, [r0, #P_ARG3] + add r1, r0, #P_ARG0 + CALL_BIF($2) + TEST_GOT_MBUF(4) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq nbif_4_simple_exception + NBIF_RET(4) + .ltorg + .size $1, .-$1 + .type $1, %function +#endif') + define(standard_bif_interface_0, ` #ifndef HAVE_$1 diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index e7ff267606..edcabfd7a4 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -330,6 +330,12 @@ nbif_2_gc_after_bif: .type nbif_3_gc_after_bif, %function nbif_3_gc_after_bif: mov r1, #3 + b .gc_after_bif + + .global nbif_4_gc_after_bif + .type nbif_4_gc_after_bif, %function +nbif_4_gc_after_bif: + mov r1, #4 /*FALLTHROUGH*/ .gc_after_bif: str r1, [P, #P_NARITY] @@ -376,6 +382,12 @@ nbif_2_simple_exception: .type nbif_3_simple_exception, %function nbif_3_simple_exception: mov r1, #3 + b .nbif_simple_exception + + .global nbif_4_simple_exception + .type nbif_4_simple_exception, %function +nbif_4_simple_exception: + mov r1, #4 /*FALLTHROUGH*/ .nbif_simple_exception: ldr r0, [P, #P_FREASON] diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 6c1de05a4c..099f4f90de 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -910,6 +910,13 @@ void hipe_emulate_fpe(Process* p) } #endif +void hipe_emasculate_binary(Eterm bin) +{ + ProcBin* pb = (ProcBin *) boxed_val(bin); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + ASSERT(pb->flags != 0); + erts_emasculate_writable_binary(pb); +} /* * args: Module, {Uniq, Index, BeamAddress} diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index d715a0914b..a3e04802df 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -140,4 +140,5 @@ atom bs_get_utf16 atom bs_validate_unicode atom bs_validate_unicode_retract atom emulate_fpe +atom emasculate_binary diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 96a849621f..370061bca1 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -250,6 +250,8 @@ gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg) nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe) #endif +noproc_primop_interface_1(nbif_emasculate_binary, hipe_emasculate_binary) + /* * SMP-specific stuff */ 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/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 3f460a5a5c..574e20e2e4 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -98,6 +98,9 @@ AEXTERN(void,nbif_emulate_fpe,(Process*)); void hipe_emulate_fpe(Process*); #endif +AEXTERN(void,nbif_emasculate_binary,(Eterm)); +void hipe_emasculate_binary(Eterm); + /* * Stuff that is different in SMP and non-SMP. */ diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index b07f4bc9c8..109289116b 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -510,22 +510,26 @@ CSYM(nbif_4_gc_after_bif): CSYM(nbif_0_simple_exception): li r4, 0 b .nbif_simple_exception + OPD(nbif_1_simple_exception) GLOBAL(CSYM(nbif_1_simple_exception)) CSYM(nbif_1_simple_exception): li r4, 1 b .nbif_simple_exception + OPD(nbif_2_simple_exception) GLOBAL(CSYM(nbif_2_simple_exception)) CSYM(nbif_2_simple_exception): li r4, 2 b .nbif_simple_exception + OPD(nbif_3_simple_exception) GLOBAL(CSYM(nbif_3_simple_exception)) CSYM(nbif_3_simple_exception): li r4, 3 b .nbif_simple_exception - OPD(nbif_3_simple_exception) + + OPD(nbif_4_simple_exception) GLOBAL(CSYM(nbif_4_simple_exception)) CSYM(nbif_4_simple_exception): li r4, 4 diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index 52b4681cfe..236f6d0a29 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -80,6 +80,7 @@ PRIMOP_LIST(am_fclearerror_error, &nbif_fclearerror_error) #ifdef NO_FPE_SIGNALS PRIMOP_LIST(am_emulate_fpe, &nbif_emulate_fpe) #endif +PRIMOP_LIST(am_emasculate_binary, &nbif_emasculate_binary) PRIMOP_LIST(am_debug_native_called, &nbif_hipe_bifs_debug_native_called) #if defined(__sparc__) diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 8dfb28c8e0..1d0ff8c16e 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -54,7 +54,7 @@ define(HANDLE_GOT_MBUF,` * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) - * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_4(nbif_name, cbif_name) * standard_bif_interface_0(nbif_name, cbif_name) * * Generate native interface for a BIF with 0-4 parameters and diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index b0064ee628..bf549c90e4 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -51,7 +51,7 @@ define(HANDLE_GOT_MBUF,` * standard_bif_interface_4(nbif_name, cbif_name) * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 0-3 parameters and + * Generate native interface for a BIF with 0-4 parameters and * standard failure mode. */ define(standard_bif_interface_1, 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..446cca77ff 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -2026,7 +2026,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; 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_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_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..699a1436ce 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -70,30 +70,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 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/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 85236e4203..9ceb393034 100644 --- a/erts/emulator/test/beam_literals_SUITE.erl +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -1,7 +1,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 @@ -226,10 +226,11 @@ literal_type_tests(Config) when is_list(Config) -> %% Generate an Erlang module with all different type of type tests. ?line Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]), ?line Mod = literal_test, - ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]}, - ?line Form = [{attribute,0,module,Mod}, - {attribute,0,compile,export_all}, - Func, {eof,0}], + Anno = erl_anno:new(0), + Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]}, + Form = [{attribute,Anno,module,Mod}, + {attribute,Anno,compile,export_all}, + Func, {eof,Anno}], %% Print generated code for inspection. ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), @@ -261,7 +262,8 @@ test(T, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. test(T, A, L) -> S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", @@ -269,7 +271,8 @@ test(T, A, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. literals() -> [42, 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/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl index 428f1242ab..bcec8fa640 100644 --- a/erts/emulator/test/code_parallel_load_SUITE.erl +++ b/erts/emulator/test/code_parallel_load_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. 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 @@ -190,13 +190,15 @@ handle_cpc_responses(N, Tag, Module) -> generate(Module, Attributes, FunStrings) -> FunForms = function_forms(FunStrings), Forms = [ - {attribute,1,module,Module}, - {attribute,2,export,[FA || {FA,_} <- FunForms]} - ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++ + {attribute,a(1),module,Module}, + {attribute,a(2),export,[FA || {FA,_} <- FunForms]} + ] ++ [{attribute, a(3), A, V}|| {A, V} <- Attributes] ++ [ Function || {_, Function} <- FunForms], {ok, Module, Bin} = compile:forms(Forms), Bin. +a(L) -> + erl_anno:new(L). function_forms([]) -> []; function_forms([S|Ss]) -> 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/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/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index ef4689b850..26f6837f19 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -1,7 +1,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 @@ -273,7 +273,8 @@ run_test_module(Cases, GuardsOk) -> ?line Bbts = lists:foldr(fun internal_bif/2, [Ok], Es), ?line Fun3 = make_function(bif_tests, Bbts), ?line Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]}, - ?line Module = make_module(op_tests, [Fun1,Fun2,Fun3,Id]), + Module0 = make_module(op_tests, [Fun1,Fun2,Fun3,Id]), + Module = erl_parse:new_anno(Module0), ?line lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module), %% Compile, load, and run the generated module. @@ -365,13 +366,16 @@ make_module(Name, Funcs) -> make_function(Name, Body) -> {function,1,Name,0,[{clause,1,[],[],Body}]}. -eval(E) -> +eval(E0) -> + E = erl_parse:new_anno(E0), ?line case catch erl_eval:exprs(E, []) of {'EXIT',Reason} -> {'EXIT',Reason}; {value,Val,_Bs} -> Val end. -unvalue(V) -> erl_parse:abstract(V). +unvalue(V) -> + Abstr = erl_parse:abstract(V), + erl_parse:anno_to_term(Abstr). value({nil,_}) -> []; value({integer,_,X}) -> X; 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..0fd6696536 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -533,16 +533,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(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ 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..3701dd8437 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -502,9 +502,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. diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 063e348836..0f68e7b27c 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -278,13 +278,16 @@ trace_info_old_code(Config) when is_list(Config) -> ?line MFA = {M,F,0} = {test,foo,0}, ?line Fname = atom_to_list(M)++".erl", ?line AbsForms = - [{attribute,1,module,M}, % -module(M). - {attribute,2,export,[{F,0}]}, % -export([F/0]). - {function,3,F,0, % F() -> - [{clause,4,[],[],[{atom,4,F}]}]}], % F. + [{attribute,a(1),module,M}, % -module(M). + {attribute,a(2),export,[{F,0}]}, % -export([F/0]). + {function,a(3),F,0, % F() -> + [{clause,a(4),[],[],[{atom,a(4),F}]}]}], % F. %% ?line {ok,M,Mbin} = compile:forms(AbsForms), ?line {module,M} = code:load_binary(M, Fname, Mbin), ?line true = erlang:delete_module(M), ?line {traced,undefined} = erlang:trace_info(MFA, traced), ok. + +a(L) -> + erl_anno:new(L). 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/etc/common/ct_run.c b/erts/etc/common/ct_run.c index bb59b93998..9e67b94f30 100644 --- a/erts/etc/common/ct_run.c +++ b/erts/etc/common/ct_run.c @@ -239,7 +239,7 @@ int main(int argc, char** argv) */ if (ct_mode == VTS_MODE) { - PUSH4("-s", "webtool", "script_start", "vts"); + PUSH4("-s", "ct_webtool", "script_start", "vts"); if (browser[0] != '\0') PUSH(browser); PUSH3("-s", "ct_run", "script_start"); } diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c index 20b78eb05e..ab420e3bee 100644 --- a/erts/etc/common/run_erl_common.c +++ b/erts/etc/common/run_erl_common.c @@ -32,6 +32,10 @@ #include <time.h> #include <unistd.h> +#ifdef __ANDROID__ +# include <termios.h> +#endif + #ifdef HAVE_SYSLOG_H # include <syslog.h> #endif diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 3478a80dd4..ce61199567 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..bee3477b2e 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..f3abb5c1c7 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index fd11c101bc..4ef4288ead 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]). @@ -427,23 +428,9 @@ call_on_load_function(_P1) -> -spec erlang:cancel_timer(TimerRef) -> Time | false 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. + +cancel_timer(_TimerRef) -> + erlang:nif_error(undefined). %% cancel_timer/2 -spec erlang:cancel_timer(TimerRef, Options) -> Time | false | ok when @@ -451,53 +438,9 @@ cancel_timer(TimerRef) -> Option :: {async, boolean()} | {info, boolean()}, 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. -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 @@ -1538,8 +1481,8 @@ raise(_Class, _Reason, _Stacktrace) -> -spec erlang:read_timer(TimerRef) -> non_neg_integer() | false when TimerRef :: reference(). -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 @@ -1547,43 +1490,8 @@ read_timer(TimerRef) -> 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. - -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 +1538,20 @@ 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], + Option :: {abs, boolean()} | {accessor, pid()}, + 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 +1624,21 @@ 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], + Option :: {abs, boolean()} | {accessor, pid()}, + 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 +1808,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). 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/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 5bf69e9294..5297d5291c 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 @@ -2439,7 +2439,8 @@ bit_string_name2pos_fun(NNL, Src) -> gen_name2pos(Fd, Name, Names) -> Cs0 = gen_name2pos_cs(Names, Name), Cs = Cs0 ++ [bit_clause(Name),nil_clause(),invalid_clause()], - F = {function,1,Name,1,Cs}, + F0 = {function,1,Name,1,Cs}, + F = erl_parse:new_anno(F0), file:write(Fd, [erl_pp:function(F)]). gen_name2pos_cs([{K,V}|T], Name) -> diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index d1c364c34a..c909c908d6 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1,2 +1 @@ -#next version number to use is 2.0 ASN1_VSN = 3.0.4 diff --git a/lib/common_test/doc/src/install_chapter.xml b/lib/common_test/doc/src/install_chapter.xml index 7f8c606324..31125b945c 100644 --- a/lib/common_test/doc/src/install_chapter.xml +++ b/lib/common_test/doc/src/install_chapter.xml @@ -34,7 +34,7 @@ <title>General information</title> <p>The two main interfaces for running tests with Common Test - are an executable program named ct_run and an + are an executable program named <c>ct_run</c> and an erlang module named <c>ct</c>. The ct_run program is compiled for the underlying operating system (e.g. Unix/Linux or Windows) during the build of the Erlang/OTP system, and is @@ -43,67 +43,10 @@ The <c>ct</c> interface functions can be called from the Erlang shell, or from any Erlang function, on any supported platform.</p> - <p>A legacy Bourne shell script - named run_test - exists, - which may be manually generated and installed. This script may be used - instead of the ct_run program mentioned above, e.g. if the user - wishes to modify or customize the Common Test start flags in a simpler - way than making changes to the ct_run C program.</p> - <p>The Common Test application is installed with the Erlang/OTP system and no additional installation step is required to start using - Common Test by means of the ct_run executable program, and/or the interface - functions in the <c>ct</c> module. If you wish to use the legacy Bourne - shell script version run_test, however, this script needs to be - generated first, according to the instructions below.</p> - - <note><p>Before reading on, please note that since Common Test version - 1.5, the run_test shell script is no longer required for starting - tests with Common Test from the OS command line. The ct_run - program (descibed above) is the new recommended command line interface - for Common Test. The shell script exists mainly for legacy reasons and - may not be updated in future releases of Common Test. It may even be removed. - </p></note> - - <p>Optional step to generate a shell script for starting Common Test:</p> - <p>To generate the run_test shell script, navigate to the - <c><![CDATA[common_test-<vsn>]]></c> directory, located among the other - OTP applications (under the OTP lib directory). Here execute the - <c>install.sh</c> script with argument <c>local</c>:</p> - - <p><c> - $ ./install.sh local - </c></p> - - <p>This generates the executable run_test script in the - <c><![CDATA[common_test-<vsn>/priv/bin]]></c> directory. The script - will include absolute paths to the Common Test and Test Server - application directories, so it's possible to copy or move the script to - a different location on the file system, if desired, without having to - update it. It's of course possible to leave the script under the - <c>priv/bin</c> directory and update the PATH variable accordingly (or - create a link or alias to it).</p> - - <p>If you, for any reason, have copied Common Test and Test Server - to a different location than the default OTP lib directory, you can - generate a run_test script with a different top level directory, - simply by specifying the directory, instead of <c>local</c>, when running - <c>install.sh</c>. Example:</p> - - <p><c> - $ install.sh /usr/local/test_tools - </c></p> - - <p>Note that the <c><![CDATA[common_test-<vsn>]]></c> and - <c><![CDATA[test_server-<vsn>]]></c> directories must be located under the - same top directory. Note also that the install script does not copy files - or update environment variables. It only generates the run_test - script.</p> - - <p>Whenever you install a new version of Erlang/OTP, the run_test - script needs to be regenerated, or updated manually with new directory names - (new version numbers), for it to "see" the latest Common Test and Test Server - versions.</p> - + Common Test by means of the <c>ct_run</c> executable program, and/or + the interface functions in the <c>ct</c> module.</p> </section> </chapter> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 822ebf146e..472e3b7833 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,66 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.10.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A fault in the Common Test logger process, that caused + the application to crash when running on a long name + node, has been corrected.</p> + <p> + Own Id: OTP-12643</p> + </item> + <item> + <p> + A 'wait_for_prompt' option in ct_telnet:expect/3 has been + introduced which forces the function to not return until + a prompt string has been received, even if other expect + patterns have already been found.</p> + <p> + Own Id: OTP-12688 Aux Id: seq12818 </p> + </item> + <item> + <p> + If the last expression in a test case causes a timetrap + timeout, the stack trace is ignored and not printed to + the test case log file. This happens because the + {Suite,TestCase,Line} info is not available in the stack + trace in this scenario, due to tail call elimination. + Common Test has been modified to handle this situation by + inserting a {Suite,TestCase,last_expr} tuple in the + correct place and printing the stack trace as expected.</p> + <p> + Own Id: OTP-12697 Aux Id: seq12848 </p> + </item> + <item> + <p> + Fixed a buffer problem in ct_netconfc which could cause + that some messages where buffered forever.</p> + <p> + Own Id: OTP-12698 Aux Id: seq12844 </p> + </item> + <item> + <p> + The VTS mode in Common Test has been modified to use a + private version of the Webtool application (ct_webtool).</p> + <p> + Own Id: OTP-12704 Aux Id: OTP-10922 </p> + </item> + <item> + <p> + Add possibility to add user capabilities in + <c>ct_netconfc:hello/3</c>.</p> + <p> + Own Id: OTP-12707 Aux Id: seq12846 </p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.10</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 864f82cb63..df60e5f7f2 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -1005,6 +1005,31 @@ for starting the tests, the relaxed scanner mode is enabled by means of the tuple: <c>{allow_user_terms,true}</c></p> </section> + <section> + <title>Reading test specification terms</title> + <p>It's possible to look up terms in the current test specification + (i.e. the spec that's been used to configure and run the current test). + The function <c>get_testspec_terms()</c> returns a list of all test spec + terms (both config- and test terms) and <c>get_testspec_terms(Tags)</c> + returns the term (or a list of terms) matching the tag (or tags) in + <c>Tags</c>.</p> + <p>For example, in the test specification:</p> + <pre> + ... + {label, my_server_smoke_test}. + {config, "../../my_server_setup.cfg"}. + {config, "../../my_server_interface.cfg"}. + ...</pre> + <p>And in e.g. a test suite or a CT hook function:</p> + <pre> + ... + [{label,[{_Node,TestType}]}, {config,CfgFiles}] = + ct:get_testspec_terms([label,config]), + + [verify_my_server_cfg(TestType, CfgFile) || {Node,CfgFile} <- CfgFiles, + Node == node()]; + ...</pre> + </section> </section> <section> diff --git a/lib/common_test/install.sh.in b/lib/common_test/install.sh.in deleted file mode 100644 index 5108c7a259..0000000000 --- a/lib/common_test/install.sh.in +++ /dev/null @@ -1,53 +0,0 @@ -#!/bin/sh - -CT_ROOT=$1 -CT_VSN=@CT_VSN@ -TS_VSN=@TS_VSN@ - -if [ -z "$CT_ROOT" ] -then - echo "install.sh: need CT_ROOT (absolute) directory or 'local' as argument" - exit 1 -fi - -if [ $CT_ROOT = "local" ] -then - CT_DIR=`pwd` - cd priv - sed -e "s,@CTPATH@,$CT_DIR/ebin," \ - -e "s,@TSPATH@,$CT_DIR/../test_server/ebin," \ - run_test.in > bin/run_test - chmod 775 bin/run_test - echo "install successful, start script created in " $CT_ROOT/common_test-$CT_VSN/priv/bin -else - - if [ ! -d "$CT_ROOT" ] - then - echo "install.sh: CT_ROOT argument must be a valid directory" - exit 1 - fi - - if [ `echo $CT_ROOT | awk '{ print substr($1,1,1) }'` != "/" ] - then - echo "install.sh: need an absolute path to CT_ROOT" - exit 1 - fi - - if [ ! -d $CT_ROOT/common_test-$CT_VSN ] - then - echo "install.sh: The directory $CT_ROOT/common_test-$CT_VSN does not exist" - exit 1 - fi - - if [ -d $CT_ROOT/common_test-$CT_VSN/priv ] - then - cd $CT_ROOT/common_test-$CT_VSN/priv - sed -e "s;@CTPATH@;$CT_ROOT/common_test-$CT_VSN/ebin;" \ - -e "s;@TSPATH@;$CT_ROOT/test_server-$TS_VSN/ebin;" \ - run_test.in > bin/run_test - chmod 775 bin/run_test - echo "install successful, start script created in " $CT_ROOT/common_test-$CT_VSN/priv/bin - fi -fi - - diff --git a/lib/common_test/priv/Makefile.in b/lib/common_test/priv/Makefile.in index 1bc6b82ebb..7765b06f95 100644 --- a/lib/common_test/priv/Makefile.in +++ b/lib/common_test/priv/Makefile.in @@ -66,12 +66,7 @@ JS = jquery-latest.js jquery.tablesorter.min.js # Rules # -include ../../test_server/vsn.mk debug opt: - $(V_at)sed -e 's;@CT_VSN@;$(VSN);' \ - -e 's;@TS_VSN@;$(TEST_SERVER_VSN);' \ - ../install.sh.in > install.sh - - $(V_at)chmod -f 775 install.sh docs: diff --git a/lib/common_test/priv/bin/.gitignore b/lib/common_test/priv/bin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/common_test/priv/bin/.gitignore +++ /dev/null diff --git a/lib/common_test/priv/run_test.in b/lib/common_test/priv/run_test.in deleted file mode 100644 index 1508751e4f..0000000000 --- a/lib/common_test/priv/run_test.in +++ /dev/null @@ -1,63 +0,0 @@ -#!/bin/sh - -args="" - -while [ $1 ]; do - if [ $1 = "-config" ]; then - args="$args -ct_config"; - elif [ $1 = "-decrypt_key" ]; then - args="$args -ct_decrypt_key"; - elif [ $1 = "-decrypt_file" ]; then - args="$args -ct_decrypt_file"; - elif [ $1 = "-vts" ]; then - vts=1; - args="$args $1"; - elif [ $1 = "-browser" ]; then - browser=$2; - args="$args $1"; - elif [ $1 = "-shell" ]; then - shell=1; - args="$args $1"; - elif [ $1 = "-ctname" ]; then - ctname=$2; - args="$args"; - elif [ $1 = "-ctmaster" ]; then - master=1; - args="$args"; - else - args="$args $1" - fi - shift -done - -if [ $vts ]; then - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s webtool script_start vts $browser \ - -s ct_run script_start \ - $args; -elif [ $shell ]; then - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s ct_run script_start \ - $args; -elif [ $ctname ]; then - erl -sname $ctname \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - $args; -elif [ $master ]; then - erl -sname ct_master \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - $args; -else - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s ct_run script_start \ - -s erlang halt \ - $args -fi diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 2723b066f0..e3d5102db8 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -62,6 +62,8 @@ MODULES= \ ct_telnet_client \ ct_make \ vts \ + ct_webtool \ + ct_webtool_sup \ unix_telnet \ ct_config \ ct_config_plain \ diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 9d8fce2789..5ed1346f1e 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -79,6 +79,7 @@ %% Other interface functions -export([get_status/0, abort_current_testcase/1, get_event_mgr_ref/0, + get_testspec_terms/0, get_testspec_terms/1, encrypt_config_file/2, encrypt_config_file/3, decrypt_config_file/2, decrypt_config_file/3]). @@ -463,6 +464,50 @@ reload_config(Required)-> ct_config:reload_config(Required). %%%----------------------------------------------------------------- +%%% @spec get_testspec_terms() -> TestSpecTerms | undefined +%%% TestSpecTerms = [{Tag,Value}] +%%% Value = [term()] +%%% +%%% @doc Get a list of all test specification terms used to +%%% configure and run this test. +%%% +get_testspec_terms() -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(CurrSpecRec) + end. + +%%%----------------------------------------------------------------- +%%% @spec get_testspec_terms(Tags) -> TestSpecTerms | undefined +%%% Tags = [Tag] | Tag +%%% Tag = atom() +%%% TestSpecTerms = [{Tag,Value}] | {Tag,Value} +%%% Value = [{Node,term()}] | [term()] +%%% Node = atom() +%%% +%%% @doc Read one or more terms from the test specification used +%%% to configure and run this test. Tag is any valid test specification +%%% tag, such as e.g. <c>label</c>, <c>config</c>, <c>logdir</c>. +%%% User specific terms are also available to read if the +%%% <c>allow_user_terms</c> option has been set. Note that all value tuples +%%% returned, except user terms, will have the node name as first element. +%%% Note also that in order to read test terms, use <c>Tag = tests</c> +%%% (rather than <c>suites</c>, <c>groups</c> or <c>cases</c>). Value is +%%% then the list of *all* tests on the form: +%%% <c>[{Node,Dir,[{TestSpec,GroupsAndCases1},...]},...], where +%%% GroupsAndCases = [{Group,[Case]}] | [Case]</c>. +get_testspec_terms(Tags) -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(Tags, CurrSpecRec) + end. + + +%%%----------------------------------------------------------------- %%% @spec log(Format) -> ok %%% @equiv log(default,50,Format,[]) log(Format) -> diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index ea3d7c8218..91368d3137 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -113,6 +113,7 @@ init_tc1(?MODULE,_,error_in_suite,[Config0]) when is_list(Config0) -> ct_event:notify(#event{name=tc_start, node=node(), data={?MODULE,error_in_suite}}), + ct_suite_init(?MODULE, error_in_suite, [], Config0), case ?val(error, Config0) of undefined -> {fail,"unknown_error_in_suite"}; @@ -635,7 +636,20 @@ try_set_default(Name,Key,Info,Where) -> end_tc(Mod, Fun, Args) -> %% Have to keep end_tc/3 for backwards compatibility issues end_tc(Mod, Fun, Args, '$end_tc_dummy'). -end_tc(?MODULE,error_in_suite,_, _) -> % bad start! +end_tc(?MODULE,error_in_suite,{Result,[Args]},Return) -> + %% this clause gets called if CT has encountered a suite that + %% can't be executed + FinalNotify = + case ct_hooks:end_tc(?MODULE, error_in_suite, Args, Result, Return) of + '$ct_no_change' -> + Result; + HookResult -> + HookResult + end, + Event = #event{name=tc_done, + node=node(), + data={?MODULE,error_in_suite,tag(FinalNotify)}}, + ct_event:sync_notify(Event), ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> end_tc(Mod,Func,TCPid,Result,Args,Return); @@ -1062,18 +1076,35 @@ get_all_cases1(_, []) -> get_all(Mod, ConfTests) -> case catch apply(Mod, all, []) of - {'EXIT',_} -> + {'EXIT',{undef,[{Mod,all,[],_} | _]}} -> Reason = case code:which(Mod) of non_existing -> list_to_atom(atom_to_list(Mod)++ - " can not be compiled or loaded"); + " can not be compiled or loaded"); _ -> list_to_atom(atom_to_list(Mod)++":all/0 is missing") end, %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Reason properly [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {'EXIT',ExitReason} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:all/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(user, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":all/0 failed"), + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Reason properly + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; AllTCs when is_list(AllTCs) -> case catch save_seqs(Mod,AllTCs) of {error,What} -> @@ -1293,6 +1324,8 @@ report(What,Data) -> end, ct_logs:unregister_groupleader(ReportingPid), case {Func,Result} of + {error_in_suite,_} when Suite == ?MODULE -> + ok; {init_per_suite,_} -> ok; {end_per_suite,_} -> diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 56082086f6..8da10ee0f3 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -24,10 +24,9 @@ -module(ct_gen_conn). --compile(export_all). - --export([start/4, stop/1, get_conn_pid/1]). +-export([start/4, stop/1, get_conn_pid/1, check_opts/1]). -export([call/2, call/3, return/2, do_within_time/2]). +-export([log/3, start_log/1, cont_log/2, end_log/0]). %%---------------------------------------------------------------------- %% Exported types diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 4d5a75d354..7c8c720e13 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -2054,6 +2054,13 @@ runentry(Dir, Totals={Node,Label,Logs, ?testname_width-3)), lists:flatten(io_lib:format("~ts...",[Trunc])) end, + TotMissingStr = + if NotBuilt > 0 -> + ["<font color=\"red\">", + integer_to_list(NotBuilt),"</font>"]; + true -> + integer_to_list(NotBuilt) + end, Total = TotSucc+TotFail+AllSkip, A = xhtml(["<td align=center><font size=\"-1\">",Node, "</font></td>\n", @@ -2073,7 +2080,7 @@ runentry(Dir, Totals={Node,Label,Logs, "<td align=right>",TotFailStr,"</td>\n", "<td align=right>",integer_to_list(AllSkip), " (",UserSkipStr,"/",AutoSkipStr,")</td>\n", - "<td align=right>",integer_to_list(NotBuilt),"</td>\n"], + "<td align=right>",TotMissingStr,"</td>\n"], TotalsStr = A++B++C, XHTML = [xhtml("<tr>\n", ["<tr class=\"",odd_or_even(),"\">\n"]), diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index af82f2dcbf..cca08bd063 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -172,6 +172,7 @@ only_open/2, hello/1, hello/2, + hello/3, close_session/1, close_session/2, kill_session/2, @@ -457,23 +458,35 @@ only_open(KeyOrName, ExtraOpts) -> %%---------------------------------------------------------------------- %% @spec hello(Client) -> Result -%% @equiv hello(Client, infinity) +%% @equiv hello(Client, [], infinity) hello(Client) -> - hello(Client,?DEFAULT_TIMEOUT). + hello(Client,[],?DEFAULT_TIMEOUT). %%---------------------------------------------------------------------- -spec hello(Client,Timeout) -> Result when Client :: handle(), Timeout :: timeout(), Result :: ok | {error,error_reason()}. +%% @spec hello(Client, Timeout) -> Result +%% @equiv hello(Client, [], Timeout) +hello(Client,Timeout) -> + hello(Client,[],Timeout). + +%%---------------------------------------------------------------------- +-spec hello(Client,Options,Timeout) -> Result when + Client :: handle(), + Options :: [{capability, [string()]}], + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. %% @doc Exchange `hello' messages with the server. %% -%% Sends a `hello' message to the server and waits for the return. -%% +%% Adds optional capabilities and sends a `hello' message to the +%% server and waits for the return. %% @end %%---------------------------------------------------------------------- -hello(Client,Timeout) -> - call(Client, {hello, Timeout}). +hello(Client,Options,Timeout) -> + call(Client, {hello, Options, Timeout}). + %%---------------------------------------------------------------------- %% @spec get_session_id(Client) -> Result @@ -1075,9 +1088,9 @@ terminate(_, #state{connection=Connection}) -> ok. %% @private -handle_msg({hello,Timeout}, From, +handle_msg({hello, Options, Timeout}, From, #state{connection=Connection,hello_status=HelloStatus} = State) -> - case do_send(Connection, client_hello()) of + case do_send(Connection, client_hello(Options)) of ok -> case HelloStatus of undefined -> @@ -1154,7 +1167,9 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) -> close_session -> stop; _ -> noreply end, - {R,State#state{pending=Pending1}}. + %% Halfhearted try to get in correct state, this matches + %% the implementation before this patch + {R,State#state{pending=Pending1, buff= <<>>}}. %% @private %% Called by ct_util_server to close registered connections before terminate. @@ -1258,10 +1273,14 @@ set_request_timer(T) -> %%%----------------------------------------------------------------- -client_hello() -> +client_hello(Options) when is_list(Options) -> + UserCaps = [{capability, UserCap} || + {capability, UserCap} <- Options, + is_list(hd(UserCap))], {hello, ?NETCONF_NAMESPACE_ATTR, [{capabilities, - [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}]}]}. + [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}| + UserCaps]}]}. %%%----------------------------------------------------------------- @@ -1344,72 +1363,54 @@ to_xml_doc(Simple) -> %%%----------------------------------------------------------------- %%% Parse and handle received XML data -handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> +handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> log(Connection,recv,NewData), - Data = <<Buff/binary,NewData/binary>>, - case xmerl_sax_parser:stream(<<>>, - [{continuation_fun,fun sax_cont/1}, - {continuation_state,{Data,Connection,false}}, - {event_fun,fun sax_event/3}, - {event_state,[]}]) of - {ok, Simple, Rest} -> - decode(Simple,State#state{buff=Rest}); - {fatal_error,_Loc,Reason,_EndTags,_EventState} -> - ?error(Connection#connection.name,[{parse_error,Reason}, - {buffer,Buff}, - {new_data,NewData}]), - case Reason of - {could_not_fetch_data,Msg} -> - handle_msg(Msg,State#state{buff = <<>>}); - _Other -> - Pending1 = - case State#state.pending of - [] -> - []; - Pending -> - %% Assuming the first request gets the - %% first answer - P=#pending{tref=TRef,caller=Caller} = - lists:last(Pending), - _ = timer:cancel(TRef), - Reason1 = {failed_to_parse_received_data,Reason}, - ct_gen_conn:return(Caller,{error,Reason1}), - lists:delete(P,Pending) - end, - {noreply,State#state{pending=Pending1,buff = <<>>}} - end - end. - -%%%----------------------------------------------------------------- -%%% Parsing of XML data -%% Contiuation function for the sax parser -sax_cont(done) -> - {<<>>,done}; -sax_cont({Data,Connection,false}) -> + Data = append_wo_initial_nl(Buff0,NewData), case binary:split(Data,[?END_TAG],[]) of - [All] -> - %% No end tag found. Remove what could be a part - %% of an end tag from the data and save for next - %% iteration - SafeSize = size(All)-5, - <<New:SafeSize/binary,Save:5/binary>> = All, - {New,{Save,Connection,true}}; - [_Msg,_Rest]=Msgs -> - %% We have at least one full message. Any excess data will - %% be returned from xmerl_sax_parser:stream/2 in the Rest - %% parameter. - {list_to_binary(Msgs),done} - end; -sax_cont({Data,Connection,true}) -> - case ssh_receive_data() of - {ok,Bin} -> - log(Connection,recv,Bin), - sax_cont({<<Data/binary,Bin/binary>>,Connection,false}); - {error,Reason} -> - throw({could_not_fetch_data,Reason}) + [_NoEndTagFound] -> + {noreply, State0#state{buff=Data}}; + [FirstMsg,Buff1] -> + SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], + case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of + {ok, Simple, _Thrash} -> + case decode(Simple, State0#state{buff=Buff1}) of + {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> + %% Recurse if we have more data in buffer + handle_data(<<>>, State); + Other -> + Other + end; + {fatal_error,_Loc,Reason,_EndTags,_EventState} -> + ?error(Connection#connection.name, + [{parse_error,Reason}, + {buffer, Buff0}, + {new_data,NewData}]), + handle_error(Reason, State0#state{buff= <<>>}) + end end. - +%% xml does not accept a leading nl and some netconf server add a nl after +%% each ?END_TAG, ignore them +append_wo_initial_nl(<<>>,NewData) -> NewData; +append_wo_initial_nl(<<"\n", Data/binary>>, NewData) -> + append_wo_initial_nl(Data, NewData); +append_wo_initial_nl(Data, NewData) -> + <<Data/binary, NewData/binary>>. + +handle_error(Reason, State) -> + Pending1 = case State#state.pending of + [] -> []; + Pending -> + %% Assuming the first request gets the + %% first answer + P=#pending{tref=TRef,caller=Caller} = + lists:last(Pending), + _ = timer:cancel(TRef), + Reason1 = {failed_to_parse_received_data,Reason}, + ct_gen_conn:return(Caller,{error,Reason1}), + lists:delete(P,Pending) + end, + {noreply, State#state{pending=Pending1}}. %% Event function for the sax parser. It builds a simple XML structure. %% Care is taken to keep namespace attributes and prefixes as in the original XML. @@ -1873,16 +1874,6 @@ get_tag([]) -> %%%----------------------------------------------------------------- %%% SSH stuff -ssh_receive_data() -> - receive - {ssh_cm, CM, {data, Ch, _Type, Data}} -> - ssh_connection:adjust_window(CM,Ch,size(Data)), - {ok, Data}; - {ssh_cm, _CM, {Closed, _Ch}} = X when Closed == closed; Closed == eof -> - {error,X}; - {_Ref,timeout} = X -> - {error,X} - end. ssh_open(#options{host=Host,timeout=Timeout,port=Port,ssh=SshOpts,name=Name}) -> case ssh:connect(Host, Port, diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 4d74fd6a80..0eafe72020 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -77,7 +77,8 @@ multiply_timetraps = 1, scale_timetraps = false, create_priv_dir, - testspecs = [], + testspec_files = [], + current_testspec, tests, starter}). @@ -225,18 +226,24 @@ finish(Tracing, ExitStatus, Args) -> if ExitStatus == interactive_mode -> interactive_mode; true -> - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> - {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) + case get_start_opt(vts, true, Args) of + true -> + %% VTS mode, don't halt the node + ok; + _ -> + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end end. @@ -244,7 +251,7 @@ script_start1(Parent, Args) -> %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), - Vts = get_start_opt(vts, true, Args), + Vts = get_start_opt(vts, true, undefined, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), CoverStop = get_start_opt(cover_stop, @@ -330,8 +337,8 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - BasicHtml = case proplists:get_value(basic_html, Args) of - undefined -> + BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of + {undefined,undefined} -> application:set_env(common_test, basic_html, false), undefined; _ -> @@ -364,9 +371,10 @@ script_start1(Parent, Args) -> scale_timetraps = ScaleTT, create_priv_dir = CreatePrivDir, starter = script}, - + %% check if log files should be refreshed or go on to run tests... Result = run_or_refresh(Opts, Args), + %% send final results to starting process waiting in script_start/0 Parent ! {self(), Result}. @@ -485,8 +493,11 @@ execute_one_spec(TS, Opts, Args) -> case check_and_install_configfiles(AllConfig, TheLogDir, Opts) of ok -> % read tests from spec {Run,Skip} = ct_testspec:prepare_tests(TS, node()), - do_run(Run, Skip, Opts#opts{config=AllConfig, - logdir=TheLogDir}, Args); + Result = do_run(Run, Skip, Opts#opts{config=AllConfig, + logdir=TheLogDir, + current_testspec=TS}, Args), + ct_util:delete_testdata(testspec), + Result; Error -> Error end. @@ -577,7 +588,7 @@ combine_test_opts(TS, Specs, Opts) -> Opts#opts{label = Label, profile = Profile, - testspecs = Specs, + testspec_files = Specs, cover = Cover, cover_stop = CoverStop, logdir = which(logdir, LogDir), @@ -702,7 +713,7 @@ script_start4(#opts{label = Label, profile = Profile, logopts = LogOpts, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, - logdir = LogDir, testspecs = Specs}, _Args) -> + logdir = LogDir, testspec_files = Specs}, _Args) -> %% label - used by ct_logs application:set_env(common_test, test_label, Label), @@ -757,21 +768,6 @@ script_start4(Opts = #opts{tests = Tests}, Args) -> %%% @doc Print usage information for <code>ct_run</code>. script_usage() -> io:format("\n\nUsage:\n\n"), - io:format("Run tests in web based GUI:\n\n" - "\tct_run -vts [-browser Browser]" - "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" - "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" - "\n\t[-suite Suite [-case Case]]" - "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" - "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" - "\n\t[-no_auto_compile]" - "\n\t[-abort_if_missing_suites]" - "\n\t[-multiply_timetraps N]" - "\n\t[-scale_timetraps]" - "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" - "\n\t[-basic_html]\n\n"), io:format("Run tests from command line:\n\n" "\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |" "\n\t[[-dir TestDir] -suite Suite1 Suite2 .. SuiteN" @@ -831,7 +827,22 @@ script_usage() -> io:format("Run CT in interactive mode:\n\n" "\tct_run -shell" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"). + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"), + io:format("Run tests in web based GUI:\n\n" + "\tct_run -vts [-browser Browser]" + "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" + "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" + "\n\t[-suite Suite [-case Case]]" + "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" + "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" + "\n\t[-multiply_timetraps N]" + "\n\t[-scale_timetraps]" + "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" + "\n\t[-basic_html]\n\n"). %%%----------------------------------------------------------------- %%% @hidden @@ -1103,7 +1114,7 @@ run_test2(StartOpts) -> undefined -> case lists:keysearch(prepared_tests, 1, StartOpts) of {value,{_,{Run,Skip},Specs}} -> % use prepared tests - run_prepared(Run, Skip, Opts#opts{testspecs = Specs}, + run_prepared(Run, Skip, Opts#opts{testspec_files = Specs}, StartOpts); false -> run_dir(Opts, StartOpts) @@ -1111,11 +1122,11 @@ run_test2(StartOpts) -> Specs -> Relaxed = get_start_opt(allow_user_terms, value, false, StartOpts), %% using testspec(s) as input for test - run_spec_file(Relaxed, Opts#opts{testspecs = Specs}, StartOpts) + run_spec_file(Relaxed, Opts#opts{testspec_files = Specs}, StartOpts) end. run_spec_file(Relaxed, - Opts = #opts{testspecs = Specs}, + Opts = #opts{testspec_files = Specs}, StartOpts) -> Specs1 = case Specs of [X|_] when is_integer(X) -> [Specs]; @@ -1154,7 +1165,10 @@ run_all_specs([{Specs,TS} | TSs], Opts, StartOpts, TotResult) -> log_ts_names(Specs), Combined = #opts{config = TSConfig} = combine_test_opts(TS, Specs, Opts), AllConfig = merge_vals([Opts#opts.config, TSConfig]), - try run_one_spec(TS, Combined#opts{config = AllConfig}, StartOpts) of + try run_one_spec(TS, + Combined#opts{config = AllConfig, + current_testspec=TS}, + StartOpts) of Result -> run_all_specs(TSs, Opts, StartOpts, [Result | TotResult]) catch @@ -1399,7 +1413,7 @@ run_testspec2(TestSpec) -> case check_and_install_configfiles( Opts#opts.config, LogDir1, Opts) of ok -> - Opts1 = Opts#opts{testspecs = [], + Opts1 = Opts#opts{testspec_files = [], logdir = LogDir1, include = AllInclude}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), @@ -1620,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)) -> @@ -1706,6 +1724,9 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), %% save logopts ct_util:set_testdata({logopts,Opts#opts.logopts}), + %% save info about current testspec (testspec record or undefined) + ct_util:set_testdata({testspec,Opts#opts.current_testspec}), + %% enable silent connections case Opts#opts.silent_connections of [] -> @@ -1720,7 +1741,7 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_logs:log("Silent connections", "~p", [Conns]) end end, - log_ts_names(Opts#opts.testspecs), + log_ts_names(Opts#opts.testspec_files), TestSuites = suite_tuples(Tests), {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index d906a267a1..b14731e74f 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -29,7 +29,7 @@ %% Command timeout = 10 sec (time to wait for a command to return) %% Max no of reconnection attempts = 3 %% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle) +%% Keep alive = true (will send NOP to the server every 8 sec if connection is idle) %% Polling limit = 0 (max number of times to poll to get a remaining string terminated) %% Polling interval = 1 sec (sleep time between polls)</pre> %% <p>These parameters can be altered by the user with the following @@ -486,7 +486,8 @@ expect(Connection,Patterns) -> %%% Opts = [Opt] %%% Opt = {idle_timeout,IdleTimeout} | {total_timeout,TotalTimeout} | %%% repeat | {repeat,N} | sequence | {halt,HaltPatterns} | -%%% ignore_prompt | no_prompt_check +%%% ignore_prompt | no_prompt_check | wait_for_prompt | +%%% {wait_for_prompt,Prompt} %%% IdleTimeout = infinity | integer() %%% TotalTimeout = infinity | integer() %%% N = integer() @@ -499,9 +500,9 @@ expect(Connection,Patterns) -> %%% %%% @doc Get data from telnet and wait for the expected pattern. %%% -%%% <p><code>Pattern</code> can be a POSIX regular expression. If more -%%% than one pattern is given, the function returns when the first -%%% match is found.</p> +%%% <p><code>Pattern</code> can be a POSIX regular expression. The function +%%% returns as soon as a pattern has been successfully matched (at least one, +%%% in the case of multiple patterns).</p> %%% %%% <p><code>RxMatch</code> is a list of matched strings. It looks %%% like this: <code>[FullMatch, SubMatch1, SubMatch2, ...]</code> @@ -524,10 +525,13 @@ expect(Connection,Patterns) -> %%% milliseconds, <code>{error,timeout}</code> is returned. The default %%% value is <code>infinity</code> (i.e. no time limit).</p> %%% -%%% <p>The function will always return when a prompt is found, unless -%%% any of the <code>ignore_prompt</code> or -%%% <code>no_prompt_check</code> options are used, in which case it -%%% will return when a match is found or after a timeout.</p> +%%% <p>The function will return when a prompt is received, even if no +%%% pattern has yet been matched. In this event, +%%% <code>{error,{prompt,Prompt}}</code> is returned. +%%% However, this behaviour may be modified with the +%%% <code>ignore_prompt</code> or <code>no_prompt_check</code> option, which +%%% tells <code>expect</code> to return only when a match is found or after a +%%% timeout.</p> %%% %%% <p>If the <code>ignore_prompt</code> option is used, %%% <code>ct_telnet</code> will ignore any prompt found. This option @@ -541,6 +545,13 @@ expect(Connection,Patterns) -> %%% is useful if, for instance, the <code>Pattern</code> itself %%% matches the prompt.</p> %%% +%%% <p>The <code>wait_for_prompt</code> option forces <code>ct_telnet</code> +%%% to wait until the prompt string has been received before returning +%%% (even if a pattern has already been matched). This is equal to calling: +%%% <code>expect(Conn, Patterns++[{prompt,Prompt}], [sequence|Opts])</code>. +%%% Note that <code>idle_timeout</code> and <code>total_timeout</code> +%%% may abort the operation of waiting for prompt.</p> +%%% %%% <p>The <code>repeat</code> option indicates that the pattern(s) %%% shall be matched multiple times. If <code>N</code> is given, the %%% pattern(s) will be matched <code>N</code> times, and the function @@ -653,18 +664,21 @@ handle_msg({cmd,Cmd,Opts},State) -> start_gen_log(heading(cmd,State#state.name)), log(State,cmd,"Cmd: ~p",[Cmd]), + %% whatever is in the buffer from previous operations + %% will be ignored as we go ahead with this telnet cmd + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), case {State#state.type,State#state.prompt} of - {ts,_} -> + {ts,_} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, prompt, State#state.prx, [{idle_timeout,2000}]); - {ip,false} -> + {ip,false} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, @@ -1007,7 +1021,7 @@ silent_teln_expect(Name,Pid,Data,Pattern,Prx,Opts) -> put(silent,Old), Result. -%% teln_expect/5 +%% teln_expect/6 %% %% This function implements the expect functionality over telnet. In %% general there are three possible ways to go: @@ -1029,10 +1043,12 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end, PromptCheck = get_prompt_check(Opts), - Seq = get_seq(Opts), - Pattern = convert_pattern(Pattern0,Seq), - {IdleTimeout,TotalTimeout} = get_timeouts(Opts), + {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts), + + Seq = get_seq(Opts1), + Pattern2 = convert_pattern(Pattern1,Seq), + {IdleTimeout,TotalTimeout} = get_timeouts(Opts1), EO = #eo{teln_pid=Pid, prx=Prx, @@ -1042,9 +1058,16 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> haltpatterns=HaltPatterns, prompt_check=PromptCheck}, - case get_repeat(Opts) of + case get_repeat(Opts1) of false -> - case teln_expect1(Name,Pid,Data,Pattern,[],EO) of + case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of + {ok,Matched,Rest} when WaitForPrompt -> + case lists:reverse(Matched) of + [{prompt,_},Matched1] -> + {ok,Matched1,Rest}; + [{prompt,_}|Matched1] -> + {ok,lists:reverse(Matched1),Rest} + end; {ok,Matched,Rest} -> {ok,Matched,Rest}; {halt,Why,Rest} -> @@ -1054,7 +1077,7 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end; N -> EO1 = EO#eo{repeat=N}, - repeat_expect(Name,Pid,Data,Pattern,[],EO1) + repeat_expect(Name,Pid,Data,Pattern2,[],EO1) end. convert_pattern(Pattern,Seq) @@ -1118,6 +1141,40 @@ get_ignore_prompt(Opts) -> get_prompt_check(Opts) -> not lists:member(no_prompt_check,Opts). +wait_for_prompt(Pattern, Opts) -> + case lists:member(wait_for_prompt, Opts) of + true -> + wait_for_prompt1(prompt, Pattern, + lists:delete(wait_for_prompt,Opts)); + false -> + case proplists:get_value(wait_for_prompt, Opts) of + undefined -> + {false,Pattern,Opts}; + PromptStr -> + wait_for_prompt1({prompt,PromptStr}, Pattern, + proplists:delete(wait_for_prompt,Opts)) + end + end. + +wait_for_prompt1(Prompt, [Ch|_] = Pattern, Opts) when is_integer(Ch) -> + wait_for_prompt2(Prompt, [Pattern], Opts); +wait_for_prompt1(Prompt, Pattern, Opts) when is_list(Pattern) -> + wait_for_prompt2(Prompt, Pattern, Opts); +wait_for_prompt1(Prompt, Pattern, Opts) -> + wait_for_prompt2(Prompt, [Pattern], Opts). + +wait_for_prompt2(Prompt, Pattern, Opts) -> + Pattern1 = case lists:reverse(Pattern) of + [prompt|_] -> Pattern; + [{prompt,_}|_] -> Pattern; + _ -> Pattern ++ [Prompt] + end, + Opts1 = case lists:member(sequence, Opts) of + true -> Opts; + false -> [sequence|Opts] + end, + {true,Pattern1,Opts1}. + %% Repeat either single or sequence. All match results are accumulated %% and returned when a halt condition is fulllfilled. repeat_expect(_Name,_Pid,Rest,_Pattern,Acc,#eo{repeat=0}) -> @@ -1210,7 +1267,7 @@ get_data1(Pid) -> %% 1) Single expect. %% First the whole data chunk is searched for a prompt (to avoid doing %% a regexp match for the prompt at each line). -%% If we are searching for anyting else, the datachunk is split into +%% If we are searching for anything else, the datachunk is split into %% lines and each line is matched against each pattern. %% one_expect: split data chunk at prompts @@ -1227,7 +1284,7 @@ one_expect(Name,Pid,Data,Pattern,EO) -> log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]), {match,{prompt,PromptType},Rest}; [{prompt,_OtherPromptType}] -> - %% Only searching for one specific prompt, not thisone + %% Only searching for one specific prompt, not this one log_lines(Name,Pid,UptoPrompt), {nomatch,Rest}; _ -> diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index b0734d8d65..757ccc0aae 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -39,7 +39,7 @@ -define(TELNET_PORT, 23). -define(OPEN_TIMEOUT,10000). --define(IDLE_TIMEOUT,10000). +-define(IDLE_TIMEOUT,8000). %% telnet control characters -define(SE, 240). @@ -114,7 +114,7 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0}], Timeout) of + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 10a9bdac67..10c3f2a938 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -27,6 +27,8 @@ collect_tests_from_list/2, collect_tests_from_list/3, collect_tests_from_file/2, collect_tests_from_file/3]). +-export([testspec_rec2list/1, testspec_rec2list/2]). + -include("ct_util.hrl"). -define(testspec_fields, record_info(fields, testspec)). @@ -973,7 +975,8 @@ add_tests([Term={Tag,all_nodes,Data}|Ts],Spec) -> should_be_added(Tag,Node,Data,Spec)], add_tests(Tests++Ts,Spec); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% create one test entry per node in Nodes and reinsert add_tests([{Tag,[],Data}|Ts],Spec) -> @@ -1001,7 +1004,8 @@ add_tests([Term={Tag,NodeOrOther,Data}|Ts],Spec) -> handle_data(Tag,Node,Data,Spec), add_tests(Ts,mod_field(Spec,Tag,NodeIxData)); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; false -> add_tests([{Tag,all_nodes,{NodeOrOther,Data}}|Ts],Spec) @@ -1012,13 +1016,15 @@ add_tests([Term={Tag,Data}|Ts],Spec) -> valid -> add_tests([{Tag,all_nodes,Data}|Ts],Spec); invalid -> - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% some other data than a tuple add_tests([Other|Ts],Spec) -> case get(relaxed) of - true -> - add_tests(Ts,Spec); + true -> + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Other]}); false -> throw({error,{undefined_term_in_spec,Other}}) end; @@ -1149,6 +1155,24 @@ per_node([N|Ns],Tag,Data,Refs) -> per_node([],_,_,_) -> []. +%% Change the testspec record "back" to a list of tuples +testspec_rec2list(Rec) -> + {Terms,_} = lists:mapfoldl(fun(unknown, Pos) -> + {element(Pos, Rec),Pos+1}; + (F, Pos) -> + {{F,element(Pos, Rec)},Pos+1} + end,2,?testspec_fields), + lists:flatten(Terms). + +%% Extract one or more values from a testspec record and +%% return the result as a list of tuples +testspec_rec2list(Field, Rec) when is_atom(Field) -> + [Term] = testspec_rec2list([Field], Rec), + Term; +testspec_rec2list(Fields, Rec) -> + Terms = testspec_rec2list(Rec), + [{Field,proplists:get_value(Field, Terms)} || Field <- Fields]. + %% read the value for FieldName in record Rec#testspec read_field(Rec, FieldName) -> catch lists:foldl(fun(F, Pos) when F == FieldName -> diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 845bb55486..f4cf407856 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -55,6 +55,7 @@ create_priv_dir=[], alias=[], tests=[], + unknown=[], merge_tests=true}). -record(cover, {app=none, diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl new file mode 100644 index 0000000000..b67a7c2a92 --- /dev/null +++ b/lib/common_test/src/ct_webtool.erl @@ -0,0 +1,1207 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% 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(ct_webtool). +-behaviour(gen_server). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The general idea is: %% +%% %% +%% %% +%% 1. Scan through the path for *.tool files and find all the web %% +%% based tools. Query each tool for configuration data. %% +%% 2. Add Alias for Erlscript and html for each tool to %% +%% the webserver configuration data. %% +%% 3. Start the webserver. %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% API functions +-export([start/0, start/2, stop/0]). + +%% Starting Webtool from a shell script +-export([script_start/0, script_start/1]). + +%% Web api +-export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). + +%% API against other tools +-export([is_localhost/0]). + +%% Debug export s +-export([get_tools1/1]). +-export([debug/1, stop_debug/0, debug_app/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-include_lib("kernel/include/file.hrl"). +-include_lib("stdlib/include/ms_transform.hrl"). + +-record(state,{priv_dir,app_data,supvis,web_data,started=[]}). + +-define(MAX_NUMBER_OF_WEBTOOLS,256). +-define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix +-define(DEFAULT_ADDR,{127,0,0,1}). + +-define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}). +-define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). +-define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). +-define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool + </TITLE>\r\n</HEAD>\r\n + <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). + +-define(HTML_END,"</BODY></HTML>"). + +-define(SEND_URL_TIMEOUT,5000). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% For debugging only. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Start tracing with +%% debug(Functions). +%% Functions = local | global | FunctionList +%% FunctionList = [Function] +%% Function = {FunctionName,Arity} | FunctionName | +%% {Module, FunctionName, Arity} | {Module,FunctionName} +debug(F) -> + ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + tp(F,MS), + ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func + ok. +tp(local,MS) -> % all functions + ttb:tpl(?MODULE,MS); +tp(global,MS) -> % all exported functions + ttb:tp(?MODULE,MS); +tp([{M,F,A}|T],MS) -> % Other module + ttb:tpl(M,F,A,MS), + tp(T,MS); +tp([{M,F}|T],MS) when is_atom(F) -> % Other module + ttb:tpl(M,F,MS), + tp(T,MS); +tp([{F,A}|T],MS) -> % function/arity + ttb:tpl(?MODULE,F,A,MS), + tp(T,MS); +tp([F|T],MS) -> % function + ttb:tpl(?MODULE,F,MS), + tp(T,MS); +tp([],_MS) -> + ok. +stop_debug() -> + ttb:stop([format]). + +debug_app(Mod) -> + ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + ttb:tp(Mod,MS), + ok. + +out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) + when W==webtool;W==mod_esi-> + io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]), + [{M,F,length(A)}|S]; +out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> + io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]), + S; +out(_,_,_,_) -> + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Functions called via script. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +script_start() -> + usage(), + halt(). +script_start([App]) -> + DefaultBrowser = + case os:type() of + {win32,_} -> iexplore; + _ -> firefox + end, + script_start([App,DefaultBrowser]); +script_start([App,Browser]) -> + io:format("Starting webtool...\n"), + start(), + AvailableApps = get_applications(), + {OSType,_} = os:type(), + case lists:keysearch(App,1,AvailableApps) of + {value,{App,StartPage}} -> + io:format("Starting ~w...\n",[App]), + start_tools([],"app=" ++ atom_to_list(App)), + PortStr = integer_to_list(get_port()), + Url = case StartPage of + "/" ++ Page -> + "http://localhost:" ++ PortStr ++ "/" ++ Page; + _ -> + "http://localhost:" ++ PortStr ++ "/" ++ StartPage + end, + case Browser of + none -> + ok; + iexplore when OSType == win32-> + io:format("Starting internet explorer...\n"), + {ok,R} = win32reg:open(""), + Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", + win32reg:change_key(R,Key), + {ok,Val} = win32reg:value(R,"Path"), + IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), + os:cmd("\"" ++ IExplore ++ "\" " ++ Url); + _ when OSType == win32 -> + io:format("Starting ~w...\n",[Browser]), + os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); + B when B==firefox; B==mozilla -> + io:format("Sending URL to ~w...",[Browser]), + BStr = atom_to_list(Browser), + SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ + Url ++ ")\'", + Port = open_port({spawn,SendCmd},[exit_status]), + receive + {Port,{exit_status,0}} -> + io:format("done\n"), + ok; + {Port,{exit_status,_Error}} -> + io:format(" not running, starting ~w...\n", + [Browser]), + os:cmd(BStr ++ " " ++ Url), + ok + after ?SEND_URL_TIMEOUT -> + io:format(" failed, starting ~w...\n",[Browser]), + erlang:port_close(Port), + os:cmd(BStr ++ " " ++ Url) + end; + _ -> + io:format("Starting ~w...\n",[Browser]), + os:cmd(atom_to_list(Browser) ++ " " ++ Url) + end, + ok; + false -> + stop(), + io:format("\n{error,{unknown_app,~p}}\n",[App]), + halt() + end. + +usage() -> + io:format("Starting webtool...\n"), + start(), + Apps = lists:map(fun({A,_}) -> A end,get_applications()), + io:format( + "\nUsage: start_webtool application [ browser ]\n" + "\nAvailable applications are: ~p\n" + "Default browser is \'iexplore\' (Internet Explorer) on Windows " + "or else \'firefox\'\n", + [Apps]), + stop(). + + +get_applications() -> + gen_server:call(ct_web_tool,get_applications). + +get_port() -> + gen_server:call(ct_web_tool,get_port). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Api functions to the genserver. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% +%---------------------------------------------------------------------- + +start()-> + start(standard_path,standard_data). + +start(Path,standard_data)-> + case get_standard_data() of + {error,Reason} -> + {error,Reason}; + Data -> + start(Path,Data) + end; + +start(standard_path,Data)-> + Path=get_path(), + start(Path,Data); + +start(Path,Port) when is_integer(Port)-> + Data = get_standard_data(Port), + start(Path,Data); + +start(Path,Data0)-> + Data = Data0 ++ rest_of_standard_data(), + gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]). + +stop()-> + gen_server:call(ct_web_tool,stoppit). + +%---------------------------------------------------------------------- +%Web Api functions called by the web +%---------------------------------------------------------------------- +started_tools(Env,Input)-> + gen_server:call(ct_web_tool,{started_tools,Env,Input}). + +toolbar(Env,Input)-> + gen_server:call(ct_web_tool,{toolbar,Env,Input}). + +start_tools(Env,Input)-> + gen_server:call(ct_web_tool,{start_tools,Env,Input}). + +stop_tools(Env,Input)-> + gen_server:call(ct_web_tool,{stop_tools,Env,Input}). +%---------------------------------------------------------------------- +%Support API for other tools +%---------------------------------------------------------------------- + +is_localhost()-> + gen_server:call(ct_web_tool,is_localhost). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%%The gen_server callback functions that builds the webbpages %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_call(get_applications,_,State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), + Tools = ets:select(State#state.app_data,MS), + {reply,Tools,State}; + +handle_call(get_port,_,State)-> + {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), + {reply,Port,State}; + +handle_call({started_tools,_Env,_Input},_,State)-> + {reply,started_tools_page(State),State}; + +handle_call({toolbar,_Env,_Input},_,State)-> + {reply,toolbar(),State}; + +handle_call({start_tools,Env,Input},_,State)-> + {NewState,Page}=start_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call({stop_tools,Env,Input},_,State)-> + {NewState,Page}=stop_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call(stoppit,_From,Data)-> + {stop,normal,ok,Data}; + +handle_call(is_localhost,_From,Data)-> + Result=case proplists:get_value(bind_address, Data#state.web_data) of + ?DEFAULT_ADDR -> + true; + _IpNumber -> + false + end, + {reply,Result,Data}. + + +handle_info(_Message,State)-> + {noreply,State}. + +handle_cast(_Request,State)-> + {noreply,State}. + +code_change(_,State,_)-> + {ok,State}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% The other functions needed by the gen_server behaviour +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% Start the gen_server +%---------------------------------------------------------------------- +init({Path,Config})-> + case filelib:is_dir(Path) of + true -> + {ok, Table} = get_tool_files_data(), + insert_app(?WEBTOOL_ALIAS, Table), + case ct_webtool_sup:start_link() of + {ok, Pid} -> + case start_webserver(Table, Path, Config) of + {ok, _} -> + print_url(Config), + {ok,#state{priv_dir=Path, + app_data=Table, + supvis=Pid, + web_data=Config}}; + {error, Error} -> + {stop, {error, Error}} + end; + Error -> + {stop,Error} + end; + false -> + {stop, {error, error_dir}} + end. + +terminate(_Reason,Data)-> + %%shut down the webbserver + shutdown_server(Data), + %%Shutdown the different tools that are started with application:start + shutdown_apps(Data), + %%Shutdown the supervisor and its children will die + shutdown_supervisor(Data), + ok. + +print_url(ConfigData)-> + Server=proplists:get_value(server_name,ConfigData,"undefined"), + Port=proplists:get_value(port,ConfigData,"undefined"), + {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), + io:format("WebTool is available at http://~s:~w/~n",[Server,Port]), + io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% begin build the pages +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +%The page that shows the started tools +%---------------------------------------------------------------------- +started_tools_page(State)-> + [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. + +toolbar()-> + [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. + + +start_tools_page(_Env,Input,State)-> + %%io:format("~n======= ~n ~p ~n============~n",[Input]), + case get_tools(Input) of + {tools,Tools}-> + %%io:format("~n======= ~n ~p ~n============~n",[Tools]), + {ok,NewState}=handle_apps(Tools,State,start), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_unstarted_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} + end. + +stop_tools_page(_Env,Input,State)-> + case get_tools(Input) of + {tools,Tools}-> + {ok,NewState}=handle_apps(Tools,State,stop), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_started_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} + end. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Functions that start and config the webserver +%% 1. Collect the config data +%% 2. Start webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Start the webserver +%---------------------------------------------------------------------- +start_webserver(Data,Path,Config)-> + case get_conf_data(Data,Path,Config) of + {ok,Conf_data}-> + %%io:format("Conf_data: ~p~n",[Conf_data]), + start_server(Conf_data); + {error,Error} -> + {error,{error_server_conf_file,Error}} + end. + +start_server(Conf_data)-> + case inets:start(httpd, Conf_data, stand_alone) of + {ok,Pid}-> + {ok,Pid}; + Error-> + {error,{server_error,Error}} + end. + +%---------------------------------------------------------------------- +% Create config data for the webserver +%---------------------------------------------------------------------- +get_conf_data(Data,Path,Config)-> + Aliases=get_aliases(Data), + ServerRoot = filename:join([Path,"root"]), + MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), + case httpd_conf:load_mime_types(MimeTypesFile) of + {ok,MimeTypes} -> + Config1 = Config ++ Aliases, + Config2 = [{server_root,ServerRoot}, + {document_root,filename:join([Path,"root/doc"])}, + {mime_types,MimeTypes} | + Config1], + {ok,Config2}; + Error -> + Error + end. + +%---------------------------------------------------------------------- +% Control the path for *.tools files +%---------------------------------------------------------------------- +get_tool_files_data()-> + Tools=get_tools1(code:get_path()), + %%io:format("Data : ~p ~n",[Tools]), + get_file_content(Tools). + +%---------------------------------------------------------------------- +%Control that the data in the file really is erlang terms +%---------------------------------------------------------------------- +get_file_content(Tools)-> + Get_data=fun({tool,ToolData}) -> + %%io:format("Data : ~p ~n",[ToolData]), + case proplists:get_value(config_func,ToolData) of + {M,F,A}-> + case catch apply(M,F,A) of + {'EXIT',_} -> + bad_data; + Data when is_tuple(Data) -> + Data; + _-> + bad_data + end; + _ -> + bad_data + end + end, + insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). + +%---------------------------------------------------------------------- +%Insert the data from the file in to the ets:table +%---------------------------------------------------------------------- +insert_file_content(Content)-> + Table=ets:new(app_data,[bag]), + lists:foreach(fun(X)-> + insert_app(X,Table) + end,Content), + {ok,Table}. + +%---------------------------------------------------------------------- +%Control that we got a a tuple of a atom and a list if so add the +%elements in the list to the ets:table +%---------------------------------------------------------------------- +insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> + %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), + lists:foreach( + fun({alias,{erl_alias,Alias,Mods}}) -> + Key_val = {erl_script_alias,{Alias,Mods}}, + %%io:format("Insert: ~p~n",[Key_val]), + ets:insert(Table,{Name,Key_val}); + (Key_val_pair)-> + %%io:format("Insert: ~p~n",[Key_val_pair]), + ets:insert(Table,{Name,Key_val_pair}) + end, + Key_val_list); + +insert_app(_,_)-> + ok. + +%---------------------------------------------------------------------- +% Select all the alias in the database +%---------------------------------------------------------------------- +get_aliases(Data)-> + MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> + {erl_script_alias,Alias}; + ({_,{alias,Alias}}) -> + {alias,Alias} + end), + ets:select(Data,MS). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Helper functions %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +get_standard_data(Port)-> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ]. + +get_standard_data()-> + case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of + {error,Reason} -> {error,Reason}; + Port -> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ] + end. + +get_free_port(_Port,0) -> + {error,no_free_port_found}; +get_free_port(Port,N) -> + case gen_tcp:connect("localhost",Port,[]) of + {error, _Reason} -> + Port; + {ok,Sock} -> + gen_tcp:close(Sock), + get_free_port(Port+1,N-1) + end. + +rest_of_standard_data() -> + [ + %% Do not allow the server to be crashed by malformed http-request + {max_header_siz,1024}, + {max_header_action,reply414}, + %% Go on a straight ip-socket + {com_type,ip_comm}, + %% Do not change the order of these module names!! + {modules,[mod_alias, + mod_auth, + mod_esi, + mod_actions, + mod_cgi, + mod_include, + mod_dir, + mod_get, + mod_head, + mod_log, + mod_disk_log]}, + {directory_index,["index.html"]}, + {default_type,"text/plain"} + ]. + + +get_path()-> + code:priv_dir(webtool). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% These functions is used to shutdown the webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Shut down the webbserver +%---------------------------------------------------------------------- +shutdown_server(State)-> + {Addr,Port} = get_addr_and_port(State#state.web_data), + inets:stop(httpd,{Addr,Port}). + +get_addr_and_port(Config) -> + Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), + Port = proplists:get_value(port,Config,?DEFAULT_PORT), + {Addr,Port}. + +%---------------------------------------------------------------------- +% Select all apps in the table and close them +%---------------------------------------------------------------------- +shutdown_apps(State)-> + Data=State#state.app_data, + MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), + lists:foreach(fun(Start_app)-> + stop_app(Start_app) + end, + ets:select(Data,MS)). + +%---------------------------------------------------------------------- +%Shuts down the supervisor that supervises tools that is not +%Designed as applications +%---------------------------------------------------------------------- +shutdown_supervisor(State)-> + %io:format("~n==================~n"), + ct_webtool_sup:stop(State#state.supvis). + %io:format("~n==================~n"). + +%---------------------------------------------------------------------- +%close the individual apps. +%---------------------------------------------------------------------- +stop_app({child,_Real_name})-> + ok; + +stop_app({app,Real_name})-> + application:stop(Real_name); + +stop_app({func,_Start,Stop})-> + case Stop of + {M,F,A} -> + catch apply(M,F,A); + _NoStop -> + ok + end. + + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webpage where the user can select if +%% to start apps or to stop apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +toolbar_page()-> + "<TABLE> + <TR> + <TD> + <B>Select Action</B> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> + </TD> + </TR> + </TABLE>". +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webbpage that shows the started apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% started_tools(State)->String (html table) +% State is a record of type state +%---------------------------------------------------------------------- +started_tools(State)-> + Names=get_started_apps(State#state.app_data,State#state.started), + "<TABLE BORDER=1 WIDTH=100%> + "++ make_rows(Names,[],0) ++" + </TABLE>". +%---------------------------------------------------------------------- +%get_started_apps(Data,Started)-> [{web_name,link}] +%selects the started apps from the ets table of apps. +%---------------------------------------------------------------------- + +get_started_apps(Data,Started)-> + SelectData=fun({Name,Link}) -> + {Name,Link} + end, + MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), + + [{"WebTool","/tool_management.html"} | + [SelectData(X) || X <- ets:select(Data,MS)]]. + +%---------------------------------------------------------------------- +% make_rows(List,Result,Fields)-> String (The rows of a htmltable +% List a list of tupler discibed above +% Result an accumulator for the result +% Field, counter that counts the number of cols in each row. +%---------------------------------------------------------------------- +make_rows([],Result,Fields)-> + Result ++ fill_out(Fields); +make_rows([Data|Paths],Result,Field)when Field==0-> + make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); + +make_rows([Path|Paths],Result,Field)when Field==4-> + make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); + +make_rows([Path|Paths],Result,Field)-> + make_rows(Paths,Result ++ make_field(Path),Field+1). + +%---------------------------------------------------------------------- +% make_fields(Path)-> String that is a field i a html table +% Path is a name url tuple {Name,url} +%---------------------------------------------------------------------- +make_field(Path)-> + "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". + + +%---------------------------------------------------------------------- +%get_name({Nae,Url})->String that represents a <A> tag in html. +%---------------------------------------------------------------------- +get_name({Name,Url})-> + "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". + + +%---------------------------------------------------------------------- +% fill_out(Nr)-> String, that represent Nr fields in a html-table. +%---------------------------------------------------------------------- +fill_out(Nr)when Nr==0-> + []; +fill_out(Nr)when Nr==4-> + "<TD WIDTH=\"20%\" > </TD></TR>"; + +fill_out(Nr)-> + "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%%These functions starts applicatons and builds the page showing tools +%%to start +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +%Controls whether the user selected a tool to start +%---------------------------------------------------------------------- +get_tools(Input)-> + case httpd:parse_query(Input) of + []-> + no_tools; + Tools-> + FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, + SelectData= + fun({Name,_Data}) -> string:equal(Name,"app") end, + {tools,[FormatData(X)||X<-Tools,SelectData(X)]} + end. + +%---------------------------------------------------------------------- +% Selects the data to start the applications the user has ordered +% starting of +%---------------------------------------------------------------------- +handle_apps([],State,_Cmd)-> + {ok,State}; + +handle_apps([Tool|Tools],State,Cmd)-> + case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of + []-> + Started = case Cmd of + start -> + [Tool|State#state.started]; + stop -> + lists:delete(Tool,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + ToStart -> + case handle_apps2(ToStart,State,Cmd) of + {ok,NewState}-> + handle_apps(Tools,NewState,Cmd); + _-> + handle_apps(Tools,State,Cmd) + end + end. + +%---------------------------------------------------------------------- +%execute every start or stop data about a tool. +%---------------------------------------------------------------------- +handle_apps2([{Name,Start_data}],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of + ok-> + Started = case Cmd of + start -> + [Name|State#state.started]; + stop -> + + lists:delete(Name,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + _-> + error + end; + +handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of + ok-> + handle_apps2(Rest,State,Cmd); + _-> + error + end. + + +%---------------------------------------------------------------------- +% Handle start and stop of applications +%---------------------------------------------------------------------- + +handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> + Action = case Cmd of + start -> + Start; + _ -> + Stop + end, + case Action of + {M,F,A} -> + case catch apply(M,F,A) of + {'EXIT',_} = Exit-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "~w:~w(~s) ->\n" + "~p\n\n", + [?LINE,Name,M,F,format_args(A),Exit]), + ets:delete(Data,Name); + _OK-> + ok + end; + _NoStart -> + ok + end; + + +handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> + case Cmd of + start -> + case catch supervisor:start_child(Pid,ChildSpec) of + {ok,_}-> + ok; + {ok,_,_}-> + ok; + {error,Reason}-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,{error,Reason}]), + ets:delete(Data,Name); + Error -> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,Error]), + ets:delete(Data,Name) + end; + stop -> + case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of + ok -> + supervisor:delete_child(websup,element(1,ChildSpec)); + _ -> + error + end + end; + + + +handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> + case Cmd of + start -> + case application:start(Real_name,temporary) of + ok-> + io:write(Name), + ok; + {error,{already_started,_}}-> + %% Remove it from the database so we dont start + %% anything already started + ets:match_delete(Data,{Name,{start,{app,Real_name}}}), + ok; + {error,_Reason}=Error-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "application:start(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Real_name,temporary,Error]), + ets:delete(Data,Name) + end; + + stop -> + application:stop(Real_name) + end; + +%---------------------------------------------------------------------- +% If the data is incorrect delete the app +%---------------------------------------------------------------------- +handle_app({Name,Incorrect},Data,_Pid,Cmd)-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not ~w application \'~p\'\n\n" + "Incorrect data: ~p\n\n", + [?LINE,Cmd,Name,Incorrect]), + ets:delete(Data,Name). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% this functions creates the page that shows the unstarted tools %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +reload_started_apps()-> + "<script> + function reloadCompiledList() + { + parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; + } + </script>". + +show_unstarted_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_available_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Start\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + To Start a Tool: + <UL> + <LI>Select the + checkbox for each tool to + start.</LI> + <LI>Click on the + button marked <EM>Start</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + + + +list_available_apps(State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), + Unstarted_apps= + lists:filter( + fun({Tool,_})-> + false==lists:member(Tool,State#state.started) + end, + ets:select(State#state.app_data,MS)), + case Unstarted_apps of + []-> + "<TR><TD>All tools are started</TD></TR>"; + _-> + list_apps(Unstarted_apps) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% these functions creates the page that shows the started apps %% +%% the user can select to shutdown %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +show_started_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_started_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Stop\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + Stop a Tool: + <UL> + <LI>Select the + checkbox for each tool to + stop.</LI> + <LI>Click on the + button marked <EM>Stop</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + +list_started_apps(State)-> + MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, + State#state.started), + Started_apps= ets:select(State#state.app_data,MS), + case Started_apps of + []-> + "<TR><TD>No tool is started yet.</TD></TR>"; + _-> + list_apps(Started_apps) + end. + + +list_apps(Apps) -> + lists:map(fun({Tool,Name})-> + "<TR><TD> + <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" + ++ atom_to_list(Tool) ++ "\"> + " ++ Name ++ " + </TD></TR>" + end, + Apps). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Collecting the data from the *.tool files %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------- +% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] +% Dirs - [string()] Directory names +% Calls get_tools2/2 recursively for a number of directories +% to retireve the configuration data for the web based tools. +%---------------------------------------- +get_tools1(Dirs)-> + get_tools1(Dirs,[]). + +get_tools1([Dir|Rest],Data) when is_list(Dir) -> + Tools=case filename:basename(Dir) of + %% Dir is an 'ebin' directory, check in '../priv' as well + "ebin" -> + [get_tools2(filename:join(filename:dirname(Dir),"priv")) | + get_tools2(Dir)]; + _ -> + get_tools2(Dir) + end, + get_tools1(Rest,[Tools|Data]); + +get_tools1([],Data) -> + lists:flatten(Data). + +%---------------------------------------- +% get_tools2(Directory) => DataList +% DataList : [WebTuple]|[] +% WebTuple: {tool,[{web,M,F,A}]} +% +%---------------------------------------- +get_tools2(Dir)-> + get_tools2(tool_files(Dir),[]). + +get_tools2([ToolFile|Rest],Data) -> + case get_tools3(ToolFile) of + {tool,WebData} -> + get_tools2(Rest,[{tool,WebData}|Data]); + {error,_Reason} -> + get_tools2(Rest,Data); + nodata -> + get_tools2(Rest,Data) + end; + +get_tools2([],Data) -> + Data. + +%---------------------------------------- +% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata +% Tool: {tool,[KeyValTuple]} +% ToolFile - string() A .tool file +% Now we have the file get the data and sort it out +%---------------------------------------- +get_tools3(ToolFile) -> + case file:consult(ToolFile) of + {error,open} -> + {error,nofile}; + {error,read} -> + {error,format}; + {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> + webdata(ToolInfo); + {ok,[{version,_Vsn},_Info]} -> + {error,old_version}; + {ok,_Other} -> + {error,format} + end. + + +%---------------------------------------------------------------------- +% webdata(TupleList)-> ToolTuple| nodata +% ToolTuple: {tool,[{config_func,{M,F,A}}]} +% +% There are a little unneccesary work in this format but it is extendable +%---------------------------------------------------------------------- +webdata(TupleList)-> + case proplists:get_value(config_func,TupleList,nodata) of + {M,F,A} -> + {tool,[{config_func,{M,F,A}}]}; + _ -> + nodata + end. + + +%============================================================================= +% Functions for getting *.tool configuration files +%============================================================================= + +%---------------------------------------- +% tool_files(Dir) => ToolFiles +% Dir - string() Directory name +% ToolFiles - [string()] +% Return the list of all files in Dir ending with .tool (appended to Dir) +%---------------------------------------- +tool_files(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> + filter_tool_files(Dir,Files); + {error,_Reason} -> + [] + end. + +%---------------------------------------- +% filter_tool_files(Dir,Files) => ToolFiles +% Dir - string() Directory name +% Files, ToolFiles - [string()] File names +% Filters out the files in Files ending with .tool and append them to Dir +%---------------------------------------- +filter_tool_files(_Dir,[]) -> + []; +filter_tool_files(Dir,[File|Rest]) -> + case filename:extension(File) of + ".tool" -> + [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; + _ -> + filter_tool_files(Dir,Rest) + end. + + +%%%----------------------------------------------------------------- +%%% format functions +ffunc({M,F,A}) when is_list(A) -> + io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]); +ffunc({M,F,A}) when is_integer(A) -> + io_lib:format("~w:~w/~w\n",[M,F,A]). + +format_args([]) -> + ""; +format_args(Args) -> + Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]), + io_lib:format(Str,Args). diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl new file mode 100644 index 0000000000..1d612a2d18 --- /dev/null +++ b/lib/common_test/src/ct_webtool_sup.erl @@ -0,0 +1,74 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +-module(ct_webtool_sup). + +-behaviour(supervisor). + +%% External exports +-export([start_link/0,stop/1]). + +%% supervisor callbacks +-export([init/1]). + +%%%---------------------------------------------------------------------- +%%% API +%%%---------------------------------------------------------------------- +start_link() -> + supervisor:start_link({local,ct_websup},ct_webtool_sup, []). + +stop(Pid)-> + exit(Pid,normal). +%%%---------------------------------------------------------------------- +%%% Callback functions from supervisor +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, {SupFlags, [ChildSpec]}} | +%% ignore | +%% {error, Reason} +%%---------------------------------------------------------------------- +init(_StartArgs) -> + %%Child1 = + %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, + %%{ok,{{simple_one_for_one,5,10},[Child1]}}. + {ok,{{one_for_one,100,10},[]}}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + + + + + + + + + + + + + + + + + + + diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index b340c6fdd1..ab13e7d0ee 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -63,21 +63,21 @@ %%%----------------------------------------------------------------- %%% User API start() -> - webtool:start(), - webtool:start_tools([],"app=vts"). + ct_webtool:start(), + ct_webtool:start_tools([],"app=vts"). init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) -> call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}). stop() -> - webtool:stop_tools([],"app=vts"), - webtool:stop(). + ct_webtool:stop_tools([],"app=vts"), + ct_webtool:stop(). report(What,Data) -> call({report,What,Data}). %%%----------------------------------------------------------------- -%%% Return config data used by webtool +%%% Return config data used by ct_webtool config_data() -> {ok,LogDir} = case lists:keysearch(logdir,1,init:get_arguments()) of diff --git a/lib/common_test/test/ct_auto_compile_SUITE.erl b/lib/common_test/test/ct_auto_compile_SUITE.erl index cc546ed30d..3e4da31ab4 100644 --- a/lib/common_test/test/ct_auto_compile_SUITE.erl +++ b/lib/common_test/test/ct_auto_compile_SUITE.erl @@ -108,6 +108,8 @@ ac_spec(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), file:copy(filename:join(DataDir, "bad_SUITE.erl"), filename:join(PrivDir, "bad_SUITE.erl")), + Suite = filename:join(DataDir, "dummy_SUITE"), + compile:file(Suite, [{outdir,PrivDir}]), TestSpec = [{label,ac_spec}, {auto_compile,false}, {suites,PrivDir,all}], @@ -160,28 +162,34 @@ events_to_check(Test, N) -> test_events(ac_flag) -> [ - {ct_test_support_eh,start_logging,{'DEF','RUNDIR'}}, - {ct_test_support_eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {ct_test_support_eh,start_info,{1,1,3}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,init_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, - {ct_test_support_eh,test_stats,{1,1,{1,0}}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,end_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, - {ct_test_support_eh,test_done,{'DEF','STOP_TIME'}}, - {ct_test_support_eh,stop_logging,[]} + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,3}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {?eh,tc_start,{dummy_SUITE,init_per_suite}}, + {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{dummy_SUITE,end_per_suite}}, + {?eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]; test_events(ac_spec) -> [ - {ct_test_support_eh,start_logging,{'DEF','RUNDIR'}}, - {ct_test_support_eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {ct_test_support_eh,start_info,{1,1,3}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,init_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, - {ct_test_support_eh,test_stats,{1,1,{1,0}}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,end_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, - {ct_test_support_eh,test_done,{'DEF','STOP_TIME'}}, - {ct_test_support_eh,stop_logging,[]} + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,3}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {?eh,tc_start,{dummy_SUITE,init_per_suite}}, + {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{dummy_SUITE,end_per_suite}}, + {?eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index e7bbdc28a5..e26ed4089a 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -150,7 +150,7 @@ hello_from_server_first(Config) -> {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(DataDir)), ct:sleep(500), ?NS:expect(hello), - ?ok = ct_netconfc:hello(Client), + ?ok = ct_netconfc:hello(Client, [{capability, ["urn:com:ericsson:ebase:1.1.0"]}], infinity), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -488,13 +488,16 @@ action(Config) -> Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}], %% test either to receive {data,Data} or {ok,Data}, %% both need to be handled - {Reply,RetVal} = case element(3, now()) rem 2 of - 0 -> {{data,Data},{ok,Data}}; - 1 -> {{ok,Data},ok} - end, - ct:log("Client will receive {~w,Data}", [element(1,Reply)]), - ?NS:expect_reply(action,Reply), - RetVal = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + ct:log("Client will receive {~w,~p}", [data,Data]), + ct:log("Expecting ~p", [{ok, Data}]), + ?NS:expect_reply(action,{data, Data}), + {ok, Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + + ct:log("Client will receive {~w,~p}", [ok,Data]), + ct:log("Expecting ~p", [ok]), + ?NS:expect_reply(action,{ok, Data}), + ok = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index 1d3f5918d2..9dc9095f47 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -40,6 +40,7 @@ all() -> expect, expect_repeat, expect_sequence, + expect_wait_until_prompt, expect_error_prompt, expect_error_timeout1, expect_error_timeout2, @@ -81,6 +82,8 @@ end_per_group(_GroupName, Config) -> expect(_) -> {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo ayt"), + {ok,["ayt"]} = ct_telnet:expect(Handle, "ayt"), + ok = ct_telnet:send(Handle, "echo ayt"), {ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]), ok = ct_telnet:close(Handle), ok. @@ -103,6 +106,21 @@ expect_sequence(_) -> ok = ct_telnet:close(Handle), ok. +%% Check that expect can wait for delayed prompt +expect_wait_until_prompt(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + Timeouts = [{idle_timeout,5000},{total_timeout,7000}], + + ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 xxx"), + {ok,["xxx"]} = + ct_telnet:expect(Handle, "xxx", + [wait_for_prompt|Timeouts]), + ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 yyy zzz"), + {ok,[["yyy"],["zzz"]]} = + ct_telnet:expect(Handle, ["yyy","zzz"], + [{wait_for_prompt,"> "}|Timeouts]), + ok. + %% Check that expect returns when a prompt is found, even if pattern %% is not matched. expect_error_prompt(_) -> diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index b6ef3062d4..214cb60c0d 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -236,14 +236,13 @@ test_events(ts_if_1) -> {ts_if_2_SUITE,end_per_suite, {failed,{error,{suite0_failed,{exited,suite0_goes_boom}}}}}}, - {?eh,tc_start,{ct_framework,error_in_suite}}, - {?eh,test_stats,{2,6,{4,7}}}, - + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'ts_if_3_SUITE:all/0 is missing'}}}}, {?eh,tc_start,{ct_framework,error_in_suite}}, - {?eh,test_stats,{2,7,{4,7}}}, - + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'Bad return value from ts_if_4_SUITE:all/0'}}}}, {?eh,tc_start,{ts_if_5_SUITE,init_per_suite}}, {?eh,tc_done,{ts_if_5_SUITE,init_per_suite, @@ -252,7 +251,7 @@ test_events(ts_if_1) -> {?eh,tc_auto_skip, {ts_if_5_SUITE,my_test_case, {require_failed_in_suite0,{not_available,undef_variable}}}}, - {?eh,test_stats,{2,7,{4,8}}}, + {?eh,test_stats,{2,5,{4,8}}}, {?eh,tc_auto_skip, {ts_if_5_SUITE,end_per_suite, {require_failed_in_suite0,{not_available,undef_variable}}}}, @@ -264,7 +263,7 @@ test_events(ts_if_1) -> {?eh,tc_auto_skip, {ts_if_6_SUITE,tc1, {failed,{error,{suite0_failed,{exited,suite0_byebye}}}}}}, - {?eh,test_stats,{2,7,{4,9}}}, + {?eh,test_stats,{2,5,{4,9}}}, {?eh,tc_auto_skip, {ct_framework,end_per_suite, {failed,{error,{suite0_failed,{exited,suite0_byebye}}}}}}, @@ -274,13 +273,13 @@ test_events(ts_if_1) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_done, {ts_if_7_SUITE,tc1,{auto_skipped,{testcase0_failed,bad_return_value}}}}, - {?eh,test_stats,{2,7,{4,10}}}, + {?eh,test_stats,{2,5,{4,10}}}, {?eh,tc_done,{ts_if_7_SUITE, {init_per_group,g1,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, {?eh,tc_auto_skip, {ts_if_7_SUITE,{tc2,g1},{group0_failed,bad_return_value}}}, - {?eh,test_stats,{2,7,{4,11}}}, + {?eh,test_stats,{2,5,{4,11}}}, {?eh,tc_auto_skip, {ts_if_7_SUITE,{end_per_group,g1},{group0_failed,bad_return_value}}}, @@ -288,7 +287,7 @@ test_events(ts_if_1) -> {?eh,tc_done,{ts_if_7_SUITE,{init_per_group,g2,[]},ok}}, {?eh,tc_done,{ts_if_7_SUITE,tc2, {auto_skipped,{testcase0_failed,bad_return_value}}}}, - {?eh,test_stats,{2,7,{4,12}}}, + {?eh,test_stats,{2,5,{4,12}}}, {?eh,tc_start,{ts_if_7_SUITE,{end_per_group,g2,[]}}}, {?eh,tc_done,{ts_if_7_SUITE,{end_per_group,g2,[]},ok}}], @@ -300,17 +299,17 @@ test_events(ts_if_1) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ts_if_8_SUITE,tc1}}, {?eh,tc_done,{ts_if_8_SUITE,tc1,{failed,{error,failed_on_purpose}}}}, - {?eh,test_stats,{2,8,{4,12}}}, + {?eh,test_stats,{2,6,{4,12}}}, {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,tc_done,{ct_framework,end_per_suite,ok}}, {?eh,tc_user_skip,{skipped_by_spec_1_SUITE,all,"should be skipped"}}, - {?eh,test_stats,{2,8,{5,12}}}, + {?eh,test_stats,{2,6,{5,12}}}, {?eh,tc_start,{skipped_by_spec_2_SUITE,init_per_suite}}, {?eh,tc_done,{skipped_by_spec_2_SUITE,init_per_suite,ok}}, {?eh,tc_user_skip,{skipped_by_spec_2_SUITE,tc1,"should be skipped"}}, - {?eh,test_stats,{2,8,{6,12}}}, + {?eh,test_stats,{2,6,{6,12}}}, {?eh,tc_start,{skipped_by_spec_2_SUITE,end_per_suite}}, {?eh,tc_done,{skipped_by_spec_2_SUITE,end_per_suite,ok}}, diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl index b8216c3596..cfc6fa93d7 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl @@ -41,8 +41,12 @@ suite() -> %% @end %%-------------------------------------------------------------------- init_per_suite(Config) -> + + TCName = ct:get_config(tcname), + CfgFiles = ct:get_config(file,undefined,[all]), + %% verify that expected config file can be read - case {ct:get_config(tcname),ct:get_config(file,undefined,[all])} of + case {TCName,CfgFiles} of {start_separate,[cfg11]} -> ok; {start_join,[cfg11,cfg21]} -> ok; {incl_separate1,[cfg11]} -> ok; @@ -56,6 +60,28 @@ init_per_suite(Config) -> _ -> ok end, + + %% test the get_testspec_terms functionality + if CfgFiles /= undefined -> + TSTerms = case ct:get_testspec_terms() of + undefined -> exit('testspec should not be undefined'); + Result -> Result + end, + true = lists:keymember(config, 1, TSTerms), + {config,TSCfgFiles} = ct:get_testspec_terms(config), + [{config,TSCfgFiles},{tests,Tests}] = + ct:get_testspec_terms([config,tests]), + CfgNames = [list_to_atom(filename:basename(TSCfgFile)) || + {Node,TSCfgFile} <- TSCfgFiles, Node == node()], + true = (length(CfgNames) == length(CfgFiles)), + [true = lists:member(CfgName,CfgFiles) || CfgName <- CfgNames], + true = lists:any(fun({{_Node,_Dir},Suites}) -> + lists:keymember(?MODULE, 1, Suites) + end, Tests); + true -> + ok + end, + Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl index 7c51aca246..c3faebbd64 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl @@ -55,7 +55,7 @@ init_per_suite(Config) -> {incl_both2,[cfg11,cfg12,cfg21]} -> ok; {incl_both2,[cfg21]} -> ok; _ -> ok - end, + end, Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl index 36c1b4279b..e189b168c7 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl @@ -41,8 +41,11 @@ suite() -> %% @end %%-------------------------------------------------------------------- init_per_suite(Config) -> + TCName = ct:get_config(tcname), + CfgFiles = ct:get_config(file,undefined,[all]), + %% verify that expected config file can be read - case {ct:get_config(tcname),ct:get_config(file,undefined,[all])} of + case {TCName,CfgFiles} of {start_separate,[cfg11]} -> ok; {start_join,[cfg11,cfg21]} -> ok; {incl_separate1,[cfg11]} -> ok; @@ -55,6 +58,28 @@ init_per_suite(Config) -> {incl_both2,[cfg11]} -> ok; _ -> ok end, + + %% test the get_testspec_terms functionality + if CfgFiles /= undefined -> + TSTerms = case ct:get_testspec_terms() of + undefined -> exit('testspec should not be undefined'); + Result -> Result + end, + true = lists:keymember(config, 1, TSTerms), + {config,TSCfgFiles} = ct:get_testspec_terms(config), + [{config,TSCfgFiles},{tests,Tests}] = + ct:get_testspec_terms([config,tests]), + CfgNames = [list_to_atom(filename:basename(TSCfgFile)) || + {Node,TSCfgFile} <- TSCfgFiles, Node == node()], + true = (length(CfgNames) == length(CfgFiles)), + [true = lists:member(CfgName,CfgFiles) || CfgName <- CfgNames], + true = lists:any(fun({{_Node,_Dir},Suites}) -> + lists:keymember(?MODULE, 1, Suites) + end, Tests); + true -> + ok + end, + Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index e073f0bfa4..107d98d72c 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -242,6 +242,12 @@ do_handle_data("echo_loop " ++ Data,State) -> ReturnData = string:join(Lines,"\n"), send_loop(list_to_integer(TStr),ReturnData,State), {ok,State}; +do_handle_data("echo_delayed_prompt "++Data,State) -> + [MsStr|EchoData] = string:tokens(Data, " "), + send(string:join(EchoData,"\n"),State), + ct:sleep(list_to_integer(MsStr)), + send("\r\n> ",State), + {ok,State}; do_handle_data("disconnect_after " ++WaitStr,State) -> Wait = list_to_integer(string:strip(WaitStr,right,$\n)), dbg("Server will close connection in ~w ms...", [Wait]), diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index d654a8afb3..e2d921729c 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.10 +COMMON_TEST_VSN = 1.10.1 diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 084686def7..73694b96ce 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -431,45 +431,35 @@ encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. encode(Tag, N) when N < 0 -> - encode1(Tag, negative_to_bytes(N, [])); + encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> (N bsl 4) bor Tag; encode(Tag, N) when N < 16#800 -> [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; encode(Tag, N) -> - encode1(Tag, to_bytes(N, [])). + encode1(Tag, to_bytes(N)). encode1(Tag, Bytes) -> - case length(Bytes) of + case iolist_size(Bytes) of Num when 2 =< Num, Num =< 8 -> [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; Num when 8 < Num -> [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes] end. - -to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - 0 -> - to_bytes_1(N0, Acc); - N -> - to_bytes(N, binary_to_list(<<N0:Bits>>) ++ Acc) - end. - -to_bytes_1(0, [B|_]=Done) when B < 128 -> Done; -to_bytes_1(N, Acc) -> to_bytes(N bsr 8, [N band 16#ff|Acc]). - -negative_to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - -1 -> - negative_to_bytes_1(N0, Acc); - N -> - negative_to_bytes_1(N, binary_to_list(<<N0:Bits>>) ++ Acc) +to_bytes(N) -> + Bin = binary:encode_unsigned(N), + case Bin of + <<0:1,_/bits>> -> Bin; + <<1:1,_/bits>> -> [0,Bin] end. -negative_to_bytes_1(-1, [B1,_B2|_]=Done) when B1 > 127 -> - Done; -negative_to_bytes_1(N, Acc) -> - negative_to_bytes_1(N bsr 8, [N band 16#ff|Acc]). +negative_to_bytes(N) when N >= -16#8000 -> + <<N:16>>; +negative_to_bytes(N) -> + Bytes = byte_size(binary:encode_unsigned(-N)), + Bin = <<N:Bytes/unit:8>>, + case Bin of + <<0:1,_/bits>> -> [16#ff,Bin]; + <<1:1,_/bits>> -> Bin + end. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 427b7071ac..2a15c1ddf3 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -615,7 +615,7 @@ collect_warnings_instr([_|Is], D, Acc) -> collect_warnings_instr([], _, Acc) -> Acc. add_warning(Term, Anno, Ws) -> - Line = abs(get_line(Anno)), + Line = get_line(Anno), File = get_file(Anno), [{File,[{Line,?MODULE,Term}]}|Ws]. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ea51673fa3..68dc104dd3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -65,7 +65,7 @@ new() -> %% Remember the highest opcode. -spec opcode(non_neg_integer(), bdict()) -> bdict(). -opcode(Op, Dict) when Dict#asm.highest_opcode > Op -> Dict; +opcode(Op, Dict) when Dict#asm.highest_opcode >= Op -> Dict; opcode(Op, Dict) -> Dict#asm{highest_opcode=Op}. %% Returns the highest opcode encountered. diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 50d1f3cdb1..726bb7f5eb 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -46,8 +46,8 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> fun ({function,Name,Arity,Entry,Asm}) -> io:format(Stream, "\n\n{function, ~w, ~w, ~w}.\n", [Name, Arity, Entry]), - foreach(fun(Op) -> print_op(Stream, Op) end, Asm) end, - Code); + io:put_chars(Stream, format_asm(Asm)) + end, Code); module(Stream, {Mod,Exp,Inter}) -> %% Other kinds of intermediate formats. io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), @@ -56,10 +56,11 @@ module(Stream, [_|_]=Fs) -> %% Form-based abstract format. foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). -print_op(Stream, Label) when element(1, Label) == label -> - io:format(Stream, " ~p.\n", [Label]); -print_op(Stream, Op) -> - io:format(Stream, " ~p.\n", [Op]). +format_asm([{label,L}|Is]) -> + [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; +format_asm([I|Is]) -> + [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; +format_asm([]) -> []. function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index fad9c42584..8181e555a1 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -172,6 +172,10 @@ remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) -> remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) -> I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)}, remap(Is, Map, [I|Acc]); +remap([{get_map_elements,Fail,M,{list,L0}}|Is], Map, Acc) -> + L = [Map(E) || E <- L0], + I = {get_map_elements,Fail,Map(M),{list,L}}, + remap(Is, Map, [I|Acc]); remap([{bs_init,Fail,Info,Live,Ss0,Dst0}|Is], Map, Acc) -> Ss = [Map(Src) || Src <- Ss0], Dst = Map(Dst0), @@ -275,6 +279,8 @@ frame_size([{kill,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> + frame_size_branch(L, Is, Safe); frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index fd666be41e..b82bcd0e95 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -128,8 +128,7 @@ empty_label_index() -> %% Add an index for a label. index_label(Lbl, Is0, Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). @@ -344,14 +343,10 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> false -> check_liveness(R, Is, St); true -> - %% We must make sure we don't check beyond this instruction - %% or we will fall through into random unrelated code and - %% get stuck in a loop. - %% - %% We don't want to overwrite a 'catch', so consider this - %% register in use. - %% - {used,St} + %% We must make sure we don't check beyond this + %% instruction or we will fall through into random + %% unrelated code and get stuck in a loop. + {killed,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -472,6 +467,22 @@ check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); check_liveness(R, [{line,_}|Is], St) -> check_liveness(R, Is, St); +check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> + {Ss,Ds} = split_even(L), + case member(R, [S|Ss]) of + true -> + {used,St0}; + false -> + case check_liveness_at(R, Fail, St0) of + {killed,St}=Killed -> + case member(R, Ds) of + true -> Killed; + false -> check_liveness(R, Is, St) + end; + Other -> + Other + end + end; check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index c55919dc73..780826b126 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,7 @@ -include("beam_disasm.hrl"). --import(lists, [reverse/1,foldl/3,foreach/2,member/2,dropwhile/2]). +-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -define(MAXREG, 1024). @@ -153,7 +153,6 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -411,37 +410,33 @@ valfun_1({'try',Dst,{f,Fail}}, Vst0) -> Vst = #vst{current=#st{ct=Fails}=St} = set_type_y({trytag,[Fail]}, Dst, Vst0), Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {catchtag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> Vst = case Fail of [FailLabel] -> branch_state(FailLabel, Vst0); _ -> Vst0 end, - set_type_reg(initialized_ct, Reg, - Vst#vst{current=St#st{ct=Fails,fls=undefined}}); + St = St0#st{ct=Fails,fls=undefined}, + set_catch_end(Reg, Vst#vst{current=St}); Type -> error({bad_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), %XXX - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), + Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; @@ -700,8 +695,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -713,8 +707,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -722,43 +715,35 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bits, Vst0), assert_term(Bin, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = bs_zero_bits(Vst1), + Vst = branch_state(Fail, Vst0), set_type_reg(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf8,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf16,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -1071,55 +1056,7 @@ bsm_restore(Reg, SavePoint, Vst) -> end; _ -> error({illegal_restore,SavePoint,range}) end. - - -%%% -%%% Validation of alignment in the bit syntax. (Currently, construction only.) -%%% -%%% We make sure that the aligned flag is only set when we can be sure of the -%%% aligment. -%%% - -bs_zero_bits(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{bits=0}}. - -bs_align_check({bs_put_utf8,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf16,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf32,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({_,_,Sz,U,Flags,_}, #vst{current=#st{bits=Bits}=St}=Vst) -> - bs_verify_flags(Flags, St), - bs_update_bits(Bits, Sz, U, St, Vst). - -bs_update_bits(undefined, _, _, _, Vst) -> Vst; -bs_update_bits(Bits0, {integer,Sz}, U, St, Vst) -> - Bits = Bits0 + U*Sz, - Vst#vst{current=St#st{bits=Bits}}; -bs_update_bits(_, {atom,all}, _, _, Vst) -> - %% A binary will not change the alignment. - Vst; -bs_update_bits(_, _, U, _, Vst) when U rem 8 =:= 0 -> - %% Units of 8, 16, and so on will not change the aligment. - Vst; -bs_update_bits(_, _, _, St, Vst) -> - %% We can no longer be sure about aligment. - Vst#vst{current=St#st{bits=undefined}}. - -bs_verify_flags({field_flags,Fl}, #st{bits=Bits}) -> - case bs_is_aligned(Fl) of - false -> ok; - true when is_integer(Bits), Bits rem 8 =:= 0 -> ok; - true -> error({aligned_flag_set,{bits,Bits}}) - end. -bs_is_aligned(Fl) when is_integer(Fl) -> Fl band 1 =:= 1; -bs_is_aligned(Fl) when is_list(Fl) -> member(aligned, Fl). - %%% %%% Keeping track of types. %%% @@ -1135,35 +1072,26 @@ set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0,numy=NumY}=St}=Vst) +set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> limit_check(Y), - case {Y,NumY} of - {_,none} -> - error({no_stack_frame,Reg}); - {_,_} when Y > NumY -> - error({y_reg_out_of_range,Reg,NumY}); - {_,_} -> - Ys = if Type =:= initialized_ct -> - gb_trees:enter(Y, initialized, Ys0); - true -> - case gb_trees:lookup(Y, Ys0) of - none -> - gb_trees:insert(Y, Type, Ys0); - {value,uinitialized} -> - gb_trees:insert(Y, Type, Ys0); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {value,_} -> - gb_trees:update(Y, Type, Ys0) - end - end, - Vst#vst{current=St#st{y=Ys}} - end; + Ys = case gb_trees:lookup(Y, Ys0) of + none -> + error({invalid_store,Reg,Type}); + {value,{catchtag,_}=Tag} -> + error(Tag); + {value,{trytag,_}=Tag} -> + error(Tag); + {value,_} -> + gb_trees:update(Y, Type, Ys0) + end, + Vst#vst{current=St#st{y=Ys}}; set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). +set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> + Ys = gb_trees:update(Y, initialized, Ys0), + Vst#vst{current=St#st{y=Ys}}. + assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. @@ -1362,13 +1290,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. + #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1398,20 +1326,24 @@ merge_regs_1([], [_|_]) -> []; merge_regs_1([_|_], []) -> []. merge_y_regs(Rs0, Rs1) -> - Rs = merge_y_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). + case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of + {Sz0,Sz1} when Sz0 < Sz1 -> + merge_y_regs_1(Sz0-1, Rs1, Rs0); + {_,Sz1} -> + merge_y_regs_1(Sz1-1, Rs0, Rs1) + end. -merge_y_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - [{R1,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - [{R2,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([], []) -> []; -merge_y_regs_1([], [_|_]=Rs) -> Rs; -merge_y_regs_1([_|_]=Rs, []) -> Rs. +merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> + Type0 = gb_trees:get(Y, Regs0), + case gb_trees:get(Y, S) of + Type0 -> + merge_y_regs_1(Y-1, S, Regs0); + Type1 -> + Type = merge_types(Type0, Type1), + Regs = gb_trees:update(Y, Type, Regs0), + merge_y_regs_1(Y-1, S, Regs) + end; +merge_y_regs_1(_, _, Regs) -> Regs. %% merge_types(Type1, Type2) -> Type %% Return the most specific type possible. @@ -1630,8 +1562,6 @@ return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> return_type_erl(exit, 1) -> exception; return_type_erl(throw, 1) -> exception; -return_type_erl(fault, 1) -> exception; -return_type_erl(fault, 2) -> exception; return_type_erl(error, 1) -> exception; return_type_erl(error, 2) -> exception; return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index f8489a800b..02cdb966ce 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -445,15 +445,14 @@ i_var_1(R, Opnd, Ctxt, Env, S) -> residualize_var(R, S); false -> S1 = st__mark_inner_pending(L, S), - case catch {ok, visit(Opnd, S1)} of - {ok, {E, S2}} -> + try visit(Opnd, S1) of + {E, S2} -> %% Note that we pass the current environment and %% context to `copy', but not the current renaming. S3 = st__clear_inner_pending(L, S2), - copy(R, Opnd, E, Ctxt, Env, S3); - {'EXIT', X} -> - exit(X); - X -> + copy(R, Opnd, E, Ctxt, Env, S3) + catch + throw:X -> %% If we use destructive update for the %% `inner-pending' flag, we must make sure to clear %% it also if we make a nonlocal return. @@ -1128,8 +1127,8 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> %% Note that we extract the results of argument expessions here; the %% expressions could still be sequences with side effects. Vs = [concrete(result(A)) || A <- As], - case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of - {ok, V} -> + try apply(atom_val(M), atom_val(F), Vs) of + V -> %% Evaluation completed normally - try to turn the result %% back into a syntax tree (representing a literal). case is_literal_term(V) of @@ -1142,8 +1141,9 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> false -> %% The result could not be represented as a literal. i_call_4(M, F, As, E, Ctxt, Env, S) - end; - _ -> + end + catch + error:_ -> %% The evaluation attempt did not complete normally. i_call_4(M, F, As, E, Ctxt, Env, S) end. @@ -1736,12 +1736,11 @@ copy_1(R, Opnd, E, Ctxt, Env, S) -> copy_inline(R, Opnd, E, Ctxt, Env, S) -> S1 = st__mark_outer_pending(Opnd#opnd.loc, S), - case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; - {'EXIT', X} -> - exit(X); - X -> + try copy_inline_1(R, E, Ctxt, Env, S1) of + {E1, S2} -> + {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)} + catch + throw:X -> %% If we use destructive update for the `outer-pending' %% flag, we must make sure to clear it upon a nonlocal %% return. @@ -1758,19 +1757,16 @@ copy_inline_1(R, E, Ctxt, Env, S) -> copy_inline_2(R, E, Ctxt, Env, S); false -> S1 = new_active_effort(get_effort_limit(S), S), - case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> + try copy_inline_2(R, E, Ctxt, Env, S1) of + {E1, S2} -> %% Revert to the old effort counter. - {E1, revert_effort(S, S2)}; - {counter_exceeded, effort, _} -> + {E1, revert_effort(S, S2)} + catch + throw:{counter_exceeded, effort, _} -> %% Aborted this inlining attempt because too much %% effort was spent. Residualize the variable and %% revert to the previous state. - residualize_var(R, S); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S) end end. @@ -1796,11 +1792,12 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% close to zero at this point. (This is an extension to the %% original algorithm.) S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), - case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of - {ok, {E1, S2}} -> + try inline(E, Ctxt, ren__identity(), Env, S1) of + {E1, S2} -> %% Revert to the old size counter. - {E1, revert_size(S, S2)}; - {counter_exceeded, size, S2} -> + {E1, revert_size(S, S2)} + catch + throw:{counter_exceeded, size, S2} -> %% Aborted this inlining attempt because it got too big. %% Residualize the variable and revert to the old size %% counter. (It is important that we do not also revert the @@ -1813,11 +1810,7 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% must make sure to clear the flags of any nested %% app-contexts upon aborting; see `inline' for details. S4 = reset_nested_apps(Ctxt, S3), % for effect - residualize_var(R, S4); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S4) end. reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 5bd33c4d18..22810c910c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -41,7 +41,7 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type err_info() :: {erl_scan:line() | 'none', +-type err_info() :: {erl_anno:line() | 'none', module(), term()}. %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. @@ -132,7 +132,8 @@ env_default_opts() -> Str when is_list(Str) -> case erl_scan:string(Str) of {ok,Tokens,_} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of + Dot = {dot, erl_anno:new(1)}, + case erl_parse:parse_term(Tokens ++ [Dot]) of {ok,List} when is_list(List) -> List; {ok,Term} -> [Term]; {error,_Reason} -> @@ -919,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}. @@ -1237,7 +1245,8 @@ save_abstract_code(#compile{ifile=File}=St) -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code,options=Opts,ofile=OFile}) -> +abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> + Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of true -> diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index beab2ce897..6f8279f65e 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2532,18 +2532,35 @@ maybe_suppress_warnings(Arg, _, _, effect) -> %% Don't suppress any warnings in effect context. Arg; maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> - case suppress_warning(Arg) of + case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> case is_any_var_used(Vs, PrevBody) of true -> - cerl:set_ann(Arg, [compiler_generated]); + suppress_warning([Arg]); false -> Arg end end. +%% Suppress warnings for a Core Erlang expression whose value will +%% be ignored. +suppress_warning([H|T]) -> + case cerl:is_literal(H) of + true -> + suppress_warning(T); + false -> + case cerl:is_data(H) of + true -> + suppress_warning(cerl:data_es(H) ++ T); + false -> + Arg = cerl:set_ann(H, [compiler_generated]), + cerl:c_seq(Arg, suppress_warning(T)) + end + end; +suppress_warning([]) -> void(). + move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, body=InnerArg0}=Outer, clauses=InnerClauses}=Inner, Sub) -> @@ -3093,7 +3110,7 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - case suppress_warning(Core) of + case should_suppress_warning(Core) of true -> ok; false -> @@ -3118,7 +3135,7 @@ get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen -suppress_warning(Core) -> +should_suppress_warning(Core) -> is_compiler_generated(Core) orelse is_result_unwanted(Core). diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index f99307c865..4c4628d580 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 @@ -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports - compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks @@ -46,9 +45,7 @@ vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0, %Local fun count - bitdefault, - bittypes + fcount=0 %Local fun count }). %% module(Forms, CompileOptions) @@ -69,15 +66,12 @@ module(Fs0, Opts0) -> %% Build initial expand record. St0 = #expand{exports=PreExp, - compile=Opts, - defined=PreExp, - bitdefault = erl_bits:system_bitdefault(), - bittypes = erl_bits:system_bittypes() + defined=PreExp }, %% Expand the functions. {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), %% Get the correct list of exported functions. - Exports = case member(export_all, St1#expand.compile) of + Exports = case member(export_all, Opts) of true -> gb_sets:to_list(St1#expand.defined); false -> St1#expand.exports end, @@ -85,7 +79,7 @@ module(Fs0, Opts0) -> {Ats,St3} = module_attrs(St1#expand{exports = Exports}), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, - St4#expand.compile}. + Opts}. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). @@ -121,7 +115,8 @@ is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), {Mpf2,St2}=module_predef_funcs_mod_info(St1), - {Mpf1++Mpf2,St2}. + Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], + {Mpf,St2}. module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 15a54a5886..aa2ebc0f85 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -2140,9 +2140,11 @@ put_stack(Val, [free|Stk]) -> [{Val}|Stk]; put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. put_stack_carefully(Val, Stk0) -> - case catch put_stack_carefully1(Val, Stk0) of - error -> error; - Stk1 when is_list(Stk1) -> Stk1 + try + put_stack_carefully1(Val, Stk0) + catch + throw:error -> + error end. put_stack_carefully1(_, []) -> throw(error); diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index ed7b55df07..ecaecb0ff6 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -83,8 +83,6 @@ -include("core_parse.hrl"). --define(REC_OFFSET, 100000000). % Also in erl_expand_records. - %% Internal core expressions and help functions. %% N.B. annotations fields in place as normal Core expressions. @@ -170,8 +168,10 @@ form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> {Fs,[attribute(F)|As],Ws,File}. -attribute({attribute,Line,Name,Val}) -> - {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +attribute(Attribute) -> + Fun = fun(A) -> [erl_anno:location(A)] end, + {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute), + {#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}. %% function_dump(module_info,_,_,_) -> ok; %% function_dump(Name,Arity,Format,Terms) -> @@ -729,7 +729,7 @@ make_bool_switch(L, E, V, T, F, #core{}) -> make_bool_switch_body(L, E, V, T, F). make_bool_switch_body(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), Error = {tuple,NegL,[{atom,NegL,badarg},V]}, {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, @@ -740,7 +740,7 @@ make_bool_switch_body(L, E, V, T, F) -> make_bool_switch_guard(_, E, _, {atom,_,true}, {atom,_,false}) -> E; make_bool_switch_guard(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, {clause,NegL,[{atom,NegL,false}],[],[F]}, @@ -869,10 +869,10 @@ constant_bin_1(Es) -> ({float,_,F}, B) -> {value,F,B}; ({atom,_,undefined}, B) -> {value,undefined,B} end, - case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of + try eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of {value,Bin,EmptyBindings} -> - Bin; - _ -> + Bin + catch error:_ -> error end. @@ -919,7 +919,7 @@ verify_suitable_fields([]) -> ok. %% (We don't need an exact result for this purpose.) count_bits(Int) -> - count_bits_1(abs_line(Int), 64). + count_bits_1(abs(Int), 64). count_bits_1(0, Bits) -> Bits; count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). @@ -2311,22 +2311,15 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). -record_anno(L, St) when L >= ?REC_OFFSET -> - case member(dialyzer, St#core.opts) of - true -> - [record | lineno_anno(L - ?REC_OFFSET, St)]; - false -> - full_anno(L, St) - end; -record_anno(L, St) when L < -?REC_OFFSET -> - case member(dialyzer, St#core.opts) of +record_anno(L, St) -> + case + erl_anno:record(L) andalso member(dialyzer, St#core.opts) + of true -> - [record | lineno_anno(L + ?REC_OFFSET, St)]; + [record | lineno_anno(L, St)]; false -> full_anno(L, St) - end; -record_anno(L, St) -> - full_anno(L, St). + end. full_anno(L, #core{wanted=false}=St) -> [result_not_wanted|lineno_anno(L, St)]; @@ -2334,13 +2327,10 @@ full_anno(L, #core{wanted=true}=St) -> lineno_anno(L, St). lineno_anno(L, St) -> - {line, Line} = erl_parse:get_attribute(L, line), - if - Line < 0 -> - [-Line] ++ St#core.file ++ [compiler_generated]; - true -> - [Line] ++ St#core.file - end. + Line = erl_anno:line(L), + Generated = erl_anno:generated(L), + CompilerGenerated = [compiler_generated || Generated], + [Line] ++ St#core.file ++ CompilerGenerated. get_lineno_anno(Ce) -> case get_anno(Ce) of @@ -2348,15 +2338,8 @@ get_lineno_anno(Ce) -> A when is_list(A) -> A end. -location(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. - -abs_line(L) -> - erl_parse:set_line(L, fun(Line) -> abs(Line) end). - -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). %% %% The following three functions are used both with cerl:cerl() and with i()'s @@ -2400,6 +2383,10 @@ format_error(bad_binary) -> format_error(badmap) -> "map construction will fail because of a type mismatch". -add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> - St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; -add_warning(_, _, St) -> St. +add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) -> + case erl_anno:generated(Anno) of + false -> + St#core{ws=[{File,[{erl_anno:location(Anno),?MODULE,Term}]}|Ws]}; + true -> + St + end. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 551cf7661b..e64dd6b9c3 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -28,7 +28,7 @@ overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1, cons_guard/1, freg_range/1,freg_uninit/1,freg_state/1, - bad_bin_match/1,bin_aligned/1,bad_dsetel/1, + bad_bin_match/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1]). @@ -57,7 +57,7 @@ groups() -> unsafe_catch,dead_code, overwrite_catchtag,overwrite_trytag,accessing_tags, bad_catch_try,cons_guard,freg_range,freg_uninit, - freg_state,bad_bin_match,bin_aligned,bad_dsetel, + freg_state,bad_bin_match,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists]}]. @@ -178,7 +178,7 @@ unsafe_catch(Config) when is_list(Config) -> ?line [{{t,small,2}, {{bs_put_integer,{f,0},{integer,16},1, - {field_flags,[aligned,unsigned,big]},{y,0}}, + {field_flags,[unsigned,big]},{y,0}}, 20, {unassigned,{y,0}}}}] = Errors, ok. @@ -211,20 +211,21 @@ accessing_tags(Config) when is_list(Config) -> bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), - ?line [{{bad_catch_try,bad_1,1}, - {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, - {{bad_catch_try,bad_2,1}, - {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, - {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, - {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, - {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, - {{bad_catch_try,bad_6,1}, - {{try_end,{y,1}},8,{bad_type,{integer,1}}}}] = Errors, + [{{bad_catch_try,bad_1,1}, + {{'catch',{x,0},{f,3}}, + 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + {{bad_catch_try,bad_2,1}, + {{catch_end,{x,9}}, + 8,{source_not_y_reg,{x,9}}}}, + {{bad_catch_try,bad_3,1}, + {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{bad_catch_try,bad_4,1}, + {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{bad_catch_try,bad_5,1}, + {{try_case,{y,1}},12,{bad_type,term}}}, + {{bad_catch_try,bad_6,1}, + {{move,{integer,1},{y,1}},7, + {invalid_store,{y,1},{integer,1}}}}] = Errors, ok. cons_guard(Config) when is_list(Config) -> @@ -298,19 +299,6 @@ bad_bin_match(Config) when is_list(Config) -> do_val(bad_bin_match, Config), ok. -bin_aligned(Config) when is_list(Config) -> - Errors = do_val(bin_aligned, Config), - ?line - [{{t,decode,1}, - {{bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}, - 10, - {aligned_flag_set,{bits,3}}}}] = Errors, - ok. - bad_dsetel(Config) when is_list(Config) -> Errors = do_val(bad_dsetel, Config), ?line diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S index 2a53f0dd93..6035f23506 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S @@ -63,11 +63,11 @@ {label,9}. {func_info,{atom,bad_catch_try},{atom,bad_3},1}. {label,10}. - {allocate,1,1}. + {allocate,2,1}. + {move,{atom,kalle},{y,1}}. {'catch',{y,0},{f,11}}. {call,1,{f,26}}. {label,11}. - {move,{atom,kalle},{y,1}}. {catch_end,{y,1}}. {test,is_tuple,{f,12},[{x,0}]}. {test,test_arity,{f,12},[{x,0},2]}. @@ -106,7 +106,7 @@ {label,17}. {func_info,{atom,bad_catch_try},{atom,bad_5},1}. {label,18}. - {allocate_zero,1,1}. + {allocate_zero,2,1}. {'try',{y,0},{f,19}}. {call,1,{f,26}}. {try_end,{y,0}}. @@ -131,7 +131,7 @@ {'try',{y,0},{f,23}}. {call,1,{f,26}}. {move,{integer,1},{y,1}}. - {try_end,{y,1}}. + {try_end,{y,0}}. {move,{atom,ok},{x,0}}. {jump,{f,24}}. {label,23}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S deleted file mode 100644 index a59f7ccc03..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S +++ /dev/null @@ -1,47 +0,0 @@ -{module, bin_aligned}. %% version = 0 - -{exports, [{decode,1},{module_info,0},{module_info,1}]}. - -{attributes, []}. - -{labels, 7}. - - -{function, decode, 1, 2}. - {label,1}. - {func_info,{atom,t},{atom,decode},1}. - {label,2}. - {move,{integer,1},{x,1}}. - {bif,size,{f,0},[{x,0}],{x,2}}. - {bs_add,{f,0},[{x,1},{x,2},1],{x,1}}. - {bs_init2,{f,0},{x,1},0,1,{field_flags,[]},{x,1}}. - {bs_put_integer,{f,0}, - {integer,3}, - 1, - {field_flags,[aligned,unsigned,big]}, - {integer,0}}. - {bs_put_binary,{f,0},{atom,all},8,{field_flags,[unsigned,big]},{x,0}}. - {bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}. - {move,{x,1},{x,0}}. - return. - - -{function, module_info, 0, 4}. - {label,3}. - {func_info,{atom,t},{atom,module_info},0}. - {label,4}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - - -{function, module_info, 1, 6}. - {label,5}. - {func_info,{atom,t},{atom,module_info},1}. - {label,6}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S index 8e27347ed5..c3656d6218 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S @@ -14,7 +14,7 @@ {allocate,1,0}. {'catch',{y,0},{f,3}}. {move,{atom,apa},{x,0}}. - {call_ext,1,{extfunc,erlang,fault,1}}. + {call_ext,1,{extfunc,erlang,error,1}}. {label,3}. {catch_end,{y,0}}. {move,{x,1},{x,0}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S index 500ac11377..f7d3f805b3 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S @@ -17,7 +17,7 @@ {bs_put_integer,{f,0}, {integer,8}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{y,0}}. {move,{x,2},{x,0}}. @@ -34,7 +34,7 @@ {bs_put_integer,{f,0}, {integer,16}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {move,{x,0},{y,0}}. {move,{x,1},{x,0}}. @@ -55,12 +55,12 @@ {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{x,0}}. {deallocate,2}. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 51e1da2cb6..f570d94f7d 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -428,41 +428,35 @@ self_compile_old_inliner(Config) when is_list(Config) -> self_compile_1(Config, "old", [verbose,{inline,500}]). self_compile_1(Config, Prefix, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(40)), + Dog = test_server:timetrap(test_server:minutes(40)), - ?line Priv = ?config(priv_dir,Config), - ?line Version = compiler_version(), + Priv = ?config(priv_dir,Config), + Version = compiler_version(), %% Compile the compiler. (In this node to get better coverage.) - ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), - ?line VsnA = Version ++ ".0", + CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), + VsnA = Version ++ ".0", compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) CompilerB = Prefix++"compiler_b", CompB = make_compiler_dir(Priv, CompilerB), - ?line VsnB = VsnA ++ ".0", + VsnB = VsnA ++ ".0", self_compile_node(CompA, CompB, VsnB, Opts), - %% Compare compiler directories. - ?line compare_compilers(CompA, CompB), + %% Compare compiler directories. The compiler directories should + %% be equal (except for beam_asm that contains the compiler version). + compare_compilers(CompA, CompB), - %% Compile and compare compiler C. - ?line CompilerC = Prefix++"compiler_c", - ?line CompC = make_compiler_dir(Priv, CompilerC), - ?line VsnC = VsnB ++ ".0", - self_compile_node(CompB, CompC, VsnC, Opts), - ?line compare_compilers(CompB, CompC), - - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. self_compile_node(CompilerDir, OutDir, Version, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(15)), - ?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ + Dog = test_server:timetrap(test_server:minutes(15)), + Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " -pa " ++ CompilerDir, - ?line Files = compiler_src(), + Files = compiler_src(), %% We don't want the cover server started on the other node, %% because it will load the same cover-compiled code as on this @@ -472,7 +466,7 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) -> fun() -> compile_compiler(Files, OutDir, Version, Opts) end, Pa), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> @@ -499,27 +493,22 @@ compiler_modules(Dir) -> [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. make_compiler_dir(Priv, Dir0) -> - ?line Dir = filename:join(Priv, Dir0), - ?line ok = file:make_dir(Dir), + Dir = filename:join(Priv, Dir0), + ok = file:make_dir(Dir), Dir. -make_current(Dir) -> - true = code:add_patha(Dir), - lists:foreach(fun(File) -> - c:l(File) - end, compiler_modules(Dir)), - io:format("~p\n", [code:which(compile)]). - compiler_version() -> - {value,{version,Version}} = lists:keysearch(version, 1, - compile:module_info(compile)), + {version,Version} = lists:keyfind(version, 1, + compile:module_info(compile)), Version. compare_compilers(ADir, BDir) -> {[],[],D} = beam_lib:cmp_dirs(ADir, BDir), - [] = [T || {A,_}=T <- D, - filename:basename(A) =/= "beam_asm.beam"]. %Contains compiler version. + %% beam_asm.beam contains compiler version and therefore it *must* + %% compare unequal. + ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], + ok. %%% %%% The only test of the following code is that it compiles. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 6d4fde662b..6b0369bf98 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -126,7 +126,8 @@ file_1(Config) when is_list(Config) -> forms_2(Config) when is_list(Config) -> Src = "/foo/bar", AbsSrc = filename:absname(Src), - {ok,simple,Binary} = compile:forms([{attribute,1,module,simple}], + Anno = erl_anno:new(1), + {ok,simple,Binary} = compile:forms([{attribute,Anno,module,simple}], [binary,{source,Src}]), code:load_binary(simple, Src, Binary), Info = simple:module_info(compile), 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/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index d91ee7ea08..512207898e 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. 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 @@ -1373,10 +1373,11 @@ literal_type_tests_1(Config) -> [{is_function,L1,L2} || L1 <- literals(), L2 <- literals()]), ?line Mod = literal_test, - ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]}, - ?line Form = [{attribute,0,module,Mod}, - {attribute,0,compile,export_all}, - Func, {eof,0}], + Anno = erl_anno:new(0), + Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]}, + Form = [{attribute,Anno,module,Mod}, + {attribute,Anno,compile,export_all}, + Func, {eof,Anno}], %% Print generated code for inspection. ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), @@ -1411,7 +1412,8 @@ test(T, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. test(T, L1, L2) -> S0 = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L1,L2,T,L1,L2]), @@ -1419,7 +1421,8 @@ test(T, L1, L2) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. smoke_disasm(Config, Mod, Bin) -> Priv = ?config(priv_dir, Config), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 68a31f14d5..f3b92aad5b 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -338,8 +338,16 @@ integer_encoding_1(Config) -> ?line do_integer_encoding(-(id(1) bsl 10000), Src, Data), ?line do_integer_encoding(id(1) bsl 10000, Src, Data), - ?line do_integer_encoding(2048, 0, Src, Data), - + do_integer_encoding(1024, 0, Src, Data), + _ = [begin + B = 1 bsl I, + do_integer_encoding(-B-1, Src, Data), + do_integer_encoding(-B, Src, Data), + do_integer_encoding(-B+1, Src, Data), + do_integer_encoding(B-1, Src, Data), + do_integer_encoding(B, Src, Data), + do_integer_encoding(B+1, Src, Data) + end || I <- lists:seq(1, 128)], io:put_chars(Src, "Last].\n\n"), ?line ok = file:close(Src), io:put_chars(Data, "0].\n\n"), @@ -372,11 +380,9 @@ do_integer_encoding(N, I0, Src, Data) -> do_integer_encoding(I, Src, Data) -> Str = integer_to_list(I), - io:put_chars(Src, Str), - io:put_chars(Src, ", \n"), - io:put_chars(Data, Str), - io:put_chars(Data, ", \n"). - + io:put_chars(Src, [Str,",\n"]), + io:put_chars(Data, [Str,",\n"]). + id(I) -> I. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index a5e2855f8c..4ffac95489 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -57,10 +57,8 @@ parallel() -> end. uniq() -> - U0 = erlang:ref_to_list(make_ref()), - U1 = re:replace(U0, "^#Ref", ""), - U = re:replace(U1, "[^[A-Za-z0-9_]+", "_", [global]), - re:replace(U, "_*$", "", [{return,list}]). + U = erlang:unique_integer([positive]), + "_" ++ integer_to_list(U). %% Retrieve the "interesting" compiler options (options for optimization %% and compatibility) for the given module. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index e996a55db6..f6ba75577d 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -733,6 +733,12 @@ no_warnings(Config) when is_list(Config) -> false -> Var; true -> [] end. + + c() -> + R0 = {r,\"abc\",undefined,os:timestamp()}, %No warning. + case R0 of + {r,V1,_V2,V3} -> {r,V1,\"def\",V3} + end. ">>, [], []}], 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/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index ce12c1beb3..b9d7506cde 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index cfc2a19ccd..e6da8409d4 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -650,11 +650,10 @@ expr({tuple,Line,Es0}, Bs0, Ieval) -> {value,list_to_tuple(Vs),Bs}; %% Map -expr({map,Line,Fs0}, Bs0, Ieval) -> - {Fs,Bs} = eval_map_fields(Fs0, Bs0, Ieval#ieval{line=Line,top=false}), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, - #{}, Fs), - {value,Value,Bs}; +expr({map,Line,Fs}, Bs0, Ieval) -> + {Map,Bs} = eval_new_map_fields(Fs, Bs0, Ieval#ieval{line=Line,top=false}, + fun expr/3), + {value,Map,Bs}; expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line,top=false}, {value,E,Bs1} = expr(E0, Bs0, Ieval), @@ -1473,11 +1472,13 @@ guard_expr({cons,_,H0,T0}, Bs) -> guard_expr({tuple,_,Es0}, Bs) -> {values,Es} = guard_exprs(Es0, Bs), {value,list_to_tuple(Es)}; -guard_expr({map,_,Fs0}, Bs) -> - Fs = eval_map_fields_guard(Fs0, Bs), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, - #{}, Fs), - {value,Value}; +guard_expr({map,_,Fs}, Bs0) -> + F = fun (G0, B0, _) -> + {value,G} = guard_expr(G0, B0), + {value,G,B0} + end, + {Map,_} = eval_new_map_fields(Fs, Bs0, #ieval{top=false}, F), + {value,Map}; guard_expr({map,_,E0,Fs0}, Bs) -> {value,E} = guard_expr(E0, Bs), Fs = eval_map_fields_guard(Fs0, Bs), @@ -1526,6 +1527,17 @@ eval_map_fields([{map_field_exact,Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> eval_map_fields([], Bs, _Ieval, _F, Acc) -> {lists:reverse(Acc),Bs}. +eval_new_map_fields(Fs, Bs0, Ieval, F) -> + eval_new_map_fields(Fs, Bs0, Ieval, F, []). + +eval_new_map_fields([{Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> + Ieval = Ieval0#ieval{line=Line}, + {value,K,Bs1} = F(K0, Bs0, Ieval), + {value,V,Bs2} = F(V0, Bs1, Ieval), + eval_new_map_fields(Fs, Bs2, Ieval0, F, [{K,V}|Acc]); +eval_new_map_fields([], Bs, _, _, Acc) -> + {maps:from_list(lists:reverse(Acc)),Bs}. + %% match(Pattern,Term,Bs) -> {match,Bs} | nomatch match(Pat, Term, Bs) -> try match1(Pat, Term, Bs, Bs) diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index ad05a7c529..379ffe8ce4 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -163,11 +163,11 @@ clauses([C0|Cs]) -> [C1|clauses(Cs)]; clauses([]) -> []. -clause({clause,Line,H0,G0,B0}, Lc) -> +clause({clause,Anno,H0,G0,B0}, Lc) -> H1 = head(H0), G1 = guard(G0), B1 = exprs(B0, Lc), - {clause,Line,H1,G1,B1}. + {clause,ln(Anno),H1,G1,B1}. head(Ps) -> patterns(Ps). @@ -181,46 +181,46 @@ patterns([]) -> []. %% N.B. Only valid patterns are included here. -pattern({var,Line,V}) -> {var,Line,V}; -pattern({char,Line,I}) -> {value,Line,I}; -pattern({integer,Line,I}) -> {value,Line,I}; -pattern({match,Line,Pat1,Pat2}) -> - {match,Line,pattern(Pat1),pattern(Pat2)}; -pattern({float,Line,F}) -> {value,Line,F}; -pattern({atom,Line,A}) -> {value,Line,A}; -pattern({string,Line,S}) -> {value,Line,S}; -pattern({nil,Line}) -> {value,Line,[]}; -pattern({cons,Line,H0,T0}) -> +pattern({var,Anno,V}) -> {var,ln(Anno),V}; +pattern({char,Anno,I}) -> {value,ln(Anno),I}; +pattern({integer,Anno,I}) -> {value,ln(Anno),I}; +pattern({match,Anno,Pat1,Pat2}) -> + {match,ln(Anno),pattern(Pat1),pattern(Pat2)}; +pattern({float,Anno,F}) -> {value,ln(Anno),F}; +pattern({atom,Anno,A}) -> {value,ln(Anno),A}; +pattern({string,Anno,S}) -> {value,ln(Anno),S}; +pattern({nil,Anno}) -> {value,ln(Anno),[]}; +pattern({cons,Anno,H0,T0}) -> H1 = pattern(H0), T1 = pattern(T0), - {cons,Line,H1,T1}; -pattern({tuple,Line,Ps0}) -> + {cons,ln(Anno),H1,T1}; +pattern({tuple,Anno,Ps0}) -> Ps1 = pattern_list(Ps0), - {tuple,Line,Ps1}; -pattern({map,Line,Fs0}) -> + {tuple,ln(Anno),Ps1}; +pattern({map,Anno,Fs0}) -> Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> {map_field_exact,L,expr(K, false),pattern(V)} end, Fs0), - {map,Line,Fs1}; -pattern({op,_,'-',{integer,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{integer,Line,I}}) -> - {value,Line,I}; -pattern({op,_,'-',{char,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{char,Line,I}}) -> - {value,Line,I}; -pattern({op,_,'-',{float,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{float,Line,I}}) -> - {value,Line,I}; -pattern({bin,Line,Grp}) -> + {map,ln(Anno),Fs1}; +pattern({op,_,'-',{integer,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{integer,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{char,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{char,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{float,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{float,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({bin,Anno,Grp}) -> Grp1 = pattern_list(Grp), - {bin,Line,Grp1}; -pattern({bin_element,Line,Expr,Size,Type}) -> + {bin,ln(Anno),Grp1}; +pattern({bin_element,Anno,Expr,Size,Type}) -> Expr1 = pattern(Expr), Size1 = expr(Size, false), - {bin_element,Line,Expr1,Size1,Type}. + {bin_element,ln(Anno),Expr1,Size1,Type}. %% These patterns are processed "in parallel" for purposes of variable %% definition etc. @@ -240,90 +240,89 @@ and_guard([G0|Gs]) -> [G1|and_guard(Gs)]; and_guard([]) -> []. -guard_test({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> +guard_test({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - {safe_bif,Line,erlang,F,As}; -guard_test({op,Line,Op,L0}) -> + {safe_bif,ln(Anno),erlang,F,As}; +guard_test({op,Anno,Op,L0}) -> true = erl_internal:arith_op(Op, 1) orelse %Assertion. erl_internal:bool_op(Op, 1), L1 = gexpr(L0), - {safe_bif,Line,erlang,Op,[L1]}; -guard_test({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> + {safe_bif,ln(Anno),erlang,Op,[L1]}; +guard_test({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {Op,Line,L1,R1}; -guard_test({op,Line,Op,L0,R0}) -> + {Op,ln(Anno),L1,R1}; +guard_test({op,Anno,Op,L0,R0}) -> true = erl_internal:comp_op(Op, 2) orelse %Assertion. erl_internal:bool_op(Op, 2) orelse erl_internal:arith_op(Op, 2), L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {safe_bif,Line,erlang,Op,[L1,R1]}; + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}; guard_test({var,_,_}=V) ->V; % Boolean var -guard_test({atom,Line,true}) -> {value,Line,true}; +guard_test({atom,Anno,true}) -> {value,ln(Anno),true}; %% All other constants at this level means false. -guard_test({atom,Line,_}) -> {value,Line,false}; -guard_test({integer,Line,_}) -> {value,Line,false}; -guard_test({char,Line,_}) -> {value,Line,false}; -guard_test({float,Line,_}) -> {value,Line,false}; -guard_test({string,Line,_}) -> {value,Line,false}; -guard_test({nil,Line}) -> {value,Line,false}; -guard_test({cons,Line,_,_}) -> {value,Line,false}; -guard_test({tuple,Line,_}) -> {value,Line,false}; -guard_test({map,Line,_}) -> {value,Line,false}; -guard_test({map,Line,_,_}) -> {value,Line,false}; -guard_test({bin,Line,_}) -> {value,Line,false}. - -gexpr({var,Line,V}) -> {var,Line,V}; -gexpr({integer,Line,I}) -> {value,Line,I}; -gexpr({char,Line,I}) -> {value,Line,I}; -gexpr({float,Line,F}) -> {value,Line,F}; -gexpr({atom,Line,A}) -> {value,Line,A}; -gexpr({string,Line,S}) -> {value,Line,S}; -gexpr({nil,Line}) -> {value,Line,[]}; -gexpr({cons,Line,H0,T0}) -> +guard_test({atom,Anno,_}) -> {value,ln(Anno),false}; +guard_test({integer,Anno,_}) -> {value,ln(Anno),false}; +guard_test({char,Anno,_}) -> {value,ln(Anno),false}; +guard_test({float,Anno,_}) -> {value,ln(Anno),false}; +guard_test({string,Anno,_}) -> {value,ln(Anno),false}; +guard_test({nil,Anno}) -> {value,ln(Anno),false}; +guard_test({cons,Anno,_,_}) -> {value,ln(Anno),false}; +guard_test({tuple,Anno,_}) -> {value,ln(Anno),false}; +guard_test({map,Anno,_}) -> {value,ln(Anno),false}; +guard_test({map,Anno,_,_}) -> {value,ln(Anno),false}; +guard_test({bin,Anno,_}) -> {value,ln(Anno),false}. + +gexpr({var,Anno,V}) -> {var,ln(Anno),V}; +gexpr({integer,Anno,I}) -> {value,ln(Anno),I}; +gexpr({char,Anno,I}) -> {value,ln(Anno),I}; +gexpr({float,Anno,F}) -> {value,ln(Anno),F}; +gexpr({atom,Anno,A}) -> {value,ln(Anno),A}; +gexpr({string,Anno,S}) -> {value,ln(Anno),S}; +gexpr({nil,Anno}) -> {value,ln(Anno),[]}; +gexpr({cons,Anno,H0,T0}) -> case {gexpr(H0),gexpr(T0)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,Line,H1,T1} + {H1,T1} -> {cons,ln(Anno),H1,T1} end; -gexpr({tuple,Line,Es0}) -> +gexpr({tuple,Anno,Es0}) -> Es1 = gexpr_list(Es0), - {tuple,Line,Es1}; -gexpr({map,Line,Fs0}) -> - Fs1 = map_fields(Fs0, fun gexpr/1), - {map,Line,Fs1}; -gexpr({map,Line,E0,Fs0}) -> + {tuple,ln(Anno),Es1}; +gexpr({map,Anno,Fs0}) -> + new_map(Fs0, Anno, fun gexpr/1); +gexpr({map,Anno,E0,Fs0}) -> E1 = gexpr(E0), Fs1 = map_fields(Fs0, fun gexpr/1), - {map,Line,E1,Fs1}; -gexpr({bin,Line,Flds0}) -> + {map,ln(Anno),E1,Fs1}; +gexpr({bin,Anno,Flds0}) -> Flds = gexpr_list(Flds0), - {bin,Line,Flds}; -gexpr({bin_element,Line,Expr0,Size0,Type}) -> + {bin,ln(Anno),Flds}; +gexpr({bin_element,Anno,Expr0,Size0,Type}) -> Expr = gexpr(Expr0), Size = gexpr(Size0), - {bin_element,Line,Expr,Size,Type}; + {bin_element,ln(Anno),Expr,Size,Type}; %%% The previous passes have added the module name 'erlang' to %%% all BIF calls, even in guards. -gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> - {dbg, Line, self, []}; -gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> + {dbg,ln(Anno),self,[]}; +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - {safe_bif,Line,erlang,F,As}; -gexpr({op,Line,Op,A0}) -> + {safe_bif,ln(Anno),erlang,F,As}; +gexpr({op,Anno,Op,A0}) -> erl_internal:arith_op(Op, 1), A1 = gexpr(A0), - {safe_bif,Line,erlang,Op,[A1]}; -gexpr({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> + {safe_bif,ln(Anno),erlang,Op,[A1]}; +gexpr({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {Op,Line,L1,R1}; -gexpr({op,Line,Op,L0,R0}) -> + {Op,ln(Anno),L1,R1}; +gexpr({op,Anno,Op,L0,R0}) -> true = erl_internal:arith_op(Op, 2) orelse erl_internal:comp_op(Op, 2) orelse erl_internal:bool_op(Op, 2), L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {safe_bif,Line,erlang,Op,[L1,R1]}. + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}. %% These expressions are processed "in parallel" for purposes of variable %% definition etc. @@ -343,175 +342,175 @@ exprs([E0|Es], Lc) -> [E1|exprs(Es, Lc)]; exprs([], _Lc) -> []. -expr({var,Line,V}, _Lc) -> {var,Line,V}; -expr({integer,Line,I}, _Lc) -> {value,Line,I}; -expr({char,Line,I}, _Lc) -> {value,Line,I}; -expr({float,Line,F}, _Lc) -> {value,Line,F}; -expr({atom,Line,A}, _Lc) -> {value,Line,A}; -expr({string,Line,S}, _Lc) -> {value,Line,S}; -expr({nil,Line}, _Lc) -> {value,Line,[]}; -expr({cons,Line,H0,T0}, _Lc) -> +expr({var,Anno,V}, _Lc) -> {var,ln(Anno),V}; +expr({integer,Anno,I}, _Lc) -> {value,ln(Anno),I}; +expr({char,Anno,I}, _Lc) -> {value,ln(Anno),I}; +expr({float,Anno,F}, _Lc) -> {value,ln(Anno),F}; +expr({atom,Anno,A}, _Lc) -> {value,ln(Anno),A}; +expr({string,Anno,S}, _Lc) -> {value,ln(Anno),S}; +expr({nil,Anno}, _Lc) -> {value,ln(Anno),[]}; +expr({cons,Anno,H0,T0}, _Lc) -> case {expr(H0, false),expr(T0, false)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,Line,H1,T1} + {H1,T1} -> {cons,ln(Anno),H1,T1} end; -expr({tuple,Line,Es0}, _Lc) -> +expr({tuple,Anno,Es0}, _Lc) -> Es1 = expr_list(Es0), - {tuple,Line,Es1}; -expr({map,Line,Fs0}, _Lc) -> - Fs1 = map_fields(Fs0), - {map,Line,Fs1}; -expr({map,Line,E0,Fs0}, _Lc) -> + {tuple,ln(Anno),Es1}; +expr({map,Anno,Fs}, _Lc) -> + new_map(Fs, Anno, fun (E) -> expr(E, false) end); +expr({map,Anno,E0,Fs0}, _Lc) -> E1 = expr(E0, false), Fs1 = map_fields(Fs0), - {map,Line,E1,Fs1}; -expr({block,Line,Es0}, Lc) -> + {map,ln(Anno),E1,Fs1}; +expr({block,Anno,Es0}, Lc) -> %% Unfold block into a sequence. Es1 = exprs(Es0, Lc), - {block,Line,Es1}; -expr({'if',Line,Cs0}, Lc) -> + {block,ln(Anno),Es1}; +expr({'if',Anno,Cs0}, Lc) -> Cs1 = icr_clauses(Cs0, Lc), - {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0}, Lc) -> + {'if',ln(Anno),Cs1}; +expr({'case',Anno,E0,Cs0}, Lc) -> E1 = expr(E0, false), Cs1 = icr_clauses(Cs0, Lc), - {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0}, Lc) -> + {'case',ln(Anno),E1,Cs1}; +expr({'receive',Anno,Cs0}, Lc) -> Cs1 = icr_clauses(Cs0, Lc), - {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0}, Lc) -> + {'receive',ln(Anno),Cs1}; +expr({'receive',Anno,Cs0,To0,ToEs0}, Lc) -> To1 = expr(To0, false), ToEs1 = exprs(ToEs0, Lc), Cs1 = icr_clauses(Cs0, Lc), - {'receive',Line,Cs1,To1,ToEs1}; -expr({'fun',Line,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> + {'receive',ln(Anno),Cs1,To1,ToEs1}; +expr({'fun',Anno,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> %% New R10B-2 format (abstract_v2). Cs = fun_clauses(Cs0), - {make_fun,Line,Name,Cs}; -expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> + {make_fun,ln(Anno),Name,Cs}; +expr({'fun',Anno,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> %% New R8 format (abstract_v2). + Line = ln(Anno), As = new_vars(A, Line), Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; -expr({named_fun,Line,FName,Cs0,{_,_,Name}}, _Lc) when is_atom(Name) -> +expr({named_fun,Anno,FName,Cs0,{_,_,Name}}, _Lc) when is_atom(Name) -> Cs = fun_clauses(Cs0), - {make_named_fun,Line,Name,FName,Cs}; -expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) + {make_named_fun,ln(Anno),Name,FName,Cs}; +expr({'fun',Anno,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) when 0 =< A, A =< 255 -> %% New format in R15 for fun M:F/A (literal values). - {value,Line,erlang:make_fun(M, F, A)}; -expr({'fun',Line,{function,M,F,A}}, _Lc) -> + {value,ln(Anno),erlang:make_fun(M, F, A)}; +expr({'fun',Anno,{function,M,F,A}}, _Lc) -> %% New format in R15 for fun M:F/A (one or more variables). MFA = expr_list([M,F,A]), - {make_ext_fun,Line,MFA}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> - {dbg,Line,self,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> - {dbg,Line,get_stacktrace,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> - {dbg,Line,throw,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> - {dbg,Line,error,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> - {dbg,Line,exit,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> - {dbg,Line,raise,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> + {make_ext_fun,ln(Anno),MFA}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> + {dbg,ln(Anno),self,[]}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> + {dbg,ln(Anno),get_stacktrace,[]}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> + {dbg,ln(Anno),throw,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> + {dbg,ln(Anno),error,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> + {dbg,ln(Anno),exit,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> + {dbg,ln(Anno),raise,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> As = expr_list(As0), - {apply,Line,As,Lc}; -expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> + {apply,ln(Anno),As,Lc}; +expr({call,Anno,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> As = expr_list(As0), case erlang:is_builtin(Mod, Func, length(As)) of false -> - {call_remote,Line,Mod,Func,As,Lc}; + {call_remote,ln(Anno),Mod,Func,As,Lc}; true -> case bif_type(Mod, Func, length(As0)) of - safe -> {safe_bif,Line,Mod,Func,As}; - unsafe ->{bif,Line,Mod,Func,As} + safe -> {safe_bif,ln(Anno),Mod,Func,As}; + unsafe ->{bif,ln(Anno),Mod,Func,As} end end; -expr({call,Line,{remote,_,Mod0,Func0},As0}, Lc) -> +expr({call,Anno,{remote,_,Mod0,Func0},As0}, Lc) -> %% New R8 format (abstract_v2). Mod = expr(Mod0, false), Func = expr(Func0, false), As = consify(expr_list(As0)), - {apply,Line,[Mod,Func,As],Lc}; -expr({call,Line,{atom,_,Func},As0}, Lc) -> + {apply,ln(Anno),[Mod,Func,As],Lc}; +expr({call,Anno,{atom,_,Func},As0}, Lc) -> As = expr_list(As0), - {local_call,Line,Func,As,Lc}; -expr({call,Line,Fun0,As0}, Lc) -> + {local_call,ln(Anno),Func,As,Lc}; +expr({call,Anno,Fun0,As0}, Lc) -> Fun = expr(Fun0, false), As = expr_list(As0), - {apply_fun,Line,Fun,As,Lc}; -expr({'catch',Line,E0}, _Lc) -> + {apply_fun,ln(Anno),Fun,As,Lc}; +expr({'catch',Anno,E0}, _Lc) -> %% No new variables added. E1 = expr(E0, false), - {'catch',Line,E1}; -expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}, Lc) -> + {'catch',ln(Anno),E1}; +expr({'try',Anno,Es0,CaseCs0,CatchCs0,As0}, Lc) -> %% No new variables added. Es = expr_list(Es0), CaseCs = icr_clauses(CaseCs0, Lc), CatchCs = icr_clauses(CatchCs0, Lc), As = expr_list(As0), - {'try',Line,Es,CaseCs,CatchCs,As}; -expr({lc,Line,E0,Gs0}, _Lc) -> %R8. + {'try',ln(Anno),Es,CaseCs,CatchCs,As}; +expr({lc,Anno,E0,Gs0}, _Lc) -> %R8. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0, false),expr(Qs, false)}; + {generate,L,pattern(P0),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0, false),expr(Qs, false)}; + {b_generate,L,pattern(P0),expr(Qs, false)}; (Expr) -> case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end end, Gs0), - {lc,Line,expr(E0, false),Gs}; -expr({bc,Line,E0,Gs0}, _Lc) -> %R12. + {lc,ln(Anno),expr(E0, false),Gs}; +expr({bc,Anno,E0,Gs0}, _Lc) -> %R12. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0, false),expr(Qs, false)}; + {generate,L,pattern(P0),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0, false),expr(Qs, false)}; + {b_generate,L,pattern(P0),expr(Qs, false)}; (Expr) -> case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end end, Gs0), - {bc,Line,expr(E0, false),Gs}; -expr({match,Line,P0,E0}, _Lc) -> + {bc,ln(Anno),expr(E0, false),Gs}; +expr({match,Anno,P0,E0}, _Lc) -> E1 = expr(E0, false), P1 = pattern(P0), - {match,Line,P1,E1}; -expr({op,Line,Op,A0}, _Lc) -> + {match,ln(Anno),P1,E1}; +expr({op,Anno,Op,A0}, _Lc) -> A1 = expr(A0, false), - {op,Line,Op,[A1]}; -expr({op,Line,'++',L0,R0}, _Lc) -> + {op,ln(Anno),Op,[A1]}; +expr({op,Anno,'++',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,append,[L1,R1]}; -expr({op,Line,'--',L0,R0}, _Lc) -> + {op,ln(Anno),append,[L1,R1]}; +expr({op,Anno,'--',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,subtract,[L1,R1]}; -expr({op,Line,'!',L0,R0}, _Lc) -> + {op,ln(Anno),subtract,[L1,R1]}; +expr({op,Anno,'!',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {send,Line,L1,R1}; -expr({op,Line,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> + {send,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {Op,Line,L1,R1}; -expr({op,Line,Op,L0,R0}, _Lc) -> + {Op,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,Op,[L1,R1]}; -expr({bin,Line,Grp}, _Lc) -> + {op,ln(Anno),Op,[L1,R1]}; +expr({bin,Anno,Grp}, _Lc) -> Grp1 = expr_list(Grp), - {bin,Line,Grp1}; -expr({bin_element,Line,Expr,Size,Type}, _Lc) -> + {bin,ln(Anno),Grp1}; +expr({bin_element,Anno,Expr,Size,Type}, _Lc) -> Expr1 = expr(Expr, false), Size1 = expr(Size, false), - {bin_element,Line,Expr1,Size1,Type}; + {bin_element,ln(Anno),Expr1,Size1,Type}; expr(Other, _Lc) -> exit({?MODULE,{unknown_expr,Other}}). @@ -519,7 +518,6 @@ consify([A|As]) -> {cons,0,A,consify(As)}; consify([]) -> {value,0,[]}. - %% -type expr_list([Expression]) -> [Expression]. %% These expressions are processed "in parallel" for purposes of variable %% definition etc. @@ -534,17 +532,35 @@ icr_clauses([C0|Cs], Lc) -> [C1|icr_clauses(Cs, Lc)]; icr_clauses([], _) -> []. -fun_clauses([{clause,L,H,G,B}|Cs]) -> - [{clause,L,head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; +fun_clauses([{clause,A,H,G,B}|Cs]) -> + [{clause,ln(A),head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; fun_clauses([]) -> []. + +new_map(Fs0, Anno, F) -> + Line = ln(Anno), + Fs1 = map_fields(Fs0, F), + Fs2 = [{ln(A),K,V} || {map_field_assoc,A,K,V} <- Fs1], + try + {value,Line,map_literal(Fs2, #{})} + catch + throw:not_literal -> + {map,Line,Fs2} + end. + +map_literal([{_,{value,_,K},{value,_,V}}|T], M) -> + map_literal(T, maps:put(K, V, M)); +map_literal([_|_], _) -> + throw(not_literal); +map_literal([], M) -> M. + map_fields(Fs) -> map_fields(Fs, fun (E) -> expr(E, false) end). -map_fields([{map_field_assoc,L,N,V}|Fs], F) -> - [{map_field_assoc,L,F(N),F(V)}|map_fields(Fs)]; -map_fields([{map_field_exact,L,N,V}|Fs], F) -> - [{map_field_exact,L,F(N),F(V)}|map_fields(Fs)]; +map_fields([{map_field_assoc,A,N,V}|Fs], F) -> + [{map_field_assoc,ln(A),F(N),F(V)}|map_fields(Fs)]; +map_fields([{map_field_exact,A,N,V}|Fs], F) -> + [{map_field_exact,ln(A),F(N),F(V)}|map_fields(Fs)]; map_fields([], _) -> []. %% new_var_name() -> VarName. @@ -564,6 +580,9 @@ new_vars(N, L, Vs) when N > 0 -> new_vars(N-1, L, [V|Vs]); new_vars(0, _, Vs) -> Vs. +ln(Anno) -> + erl_anno:line(Anno). + bif_type(erlang, Name, Arity) -> case erl_internal:guard_bif(Name, Arity) of true -> diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 908390ce50..33954ca82c 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 457863d982..12fdd184b8 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -2219,7 +2219,7 @@ map_guard_sequence_mixed(K1,K2,M) -> t_frequency_table(Config) when is_list(Config) -> random:seed({13,1337,54}), % pseudo random - N = 100000, + N = 1000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), ok = check_frequency(Ts,Tf), 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/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 1cc9528fed..e29fc3ba8b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -385,10 +385,11 @@ get_optional_callbacks(Abs) -> %% - Constraint is of the form {subtype, T1, T2} where T1 and T2 %% are erl_types:erl_type() -get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], +get_spec_info([{attribute, Attr, Contract, {Id, TypeSpec}}|Left], SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> + Ln = erl_anno:line(Attr), MFA = case Id of {_, _, _} = T -> T; {F, A} -> {ModName, F, A} @@ -519,7 +520,7 @@ get_options1([], Warnings) -> Warnings. -type collected_attribute() :: - {Args :: term(), erl_scan:line(), file:filename()}. + {Args :: term(), erl_anno:line(), file:filename()}. collect_attribute(Abs, Tag) -> collect_attribute(Abs, Tag, "nofile"). @@ -643,7 +644,7 @@ get_options_with_tag(Tag, Abs) -> %% Check F/A, and collect (unchecked) warning tags with line and file. -spec check_fa_list([collected_attribute()], atom(), [fa()]) -> - [{{atom(), erl_scan:line(), file:filename()},fa()}]. + [{{atom(), erl_anno:line(), file:filename()},fa()}]. check_fa_list(AttrFile, Tag, Functions) -> FuncTab = gb_sets:from_list(Functions), diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum new file mode 100644 index 0000000000..a19c0bba96 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -0,0 +1,4 @@ + +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (#{}) -> any() +maps_sum.erl:26: Function wrong2/1 has no local return +maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) 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/dialyzer/test/small_SUITE_data/src/maps_sum.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_sum.erl new file mode 100644 index 0000000000..a73ac555c9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_sum.erl @@ -0,0 +1,31 @@ +-module(maps_sum). +-export([correct1/1, + wrong1/1, + wrong2/1]). + +-spec correct1(#{atom() => term()}) -> integer(). + +correct1(Data) -> + maps:fold(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). + +-spec wrong1([{atom(),term()}]) -> integer(). + +wrong1(Data) -> + maps:fold(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). + +-spec wrong2(#{atom() => term()}) -> integer(). + +wrong2(Data) -> + lists:foldl(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 6e41b01c44..ea175a58b8 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -1820,7 +1820,8 @@ The information presented here is as in the <c>connect</c> case except that the client connections are grouped under an <c>accept</c> tuple.</p> <p> -Whether or not the &transport_opt; <c>pool_size</c> affects the format +Whether or not the &transport_opt; <c>pool_size</c> has been +configured affects the format of the listing in the case of a connecting transport, since a value greater than 1 implies multiple transport processes for the same <c>&transport_ref;</c>, as in the listening case. diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 479fab21b2..6931788c83 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,47 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.9.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Don't leave extra bit in decoded AVP data.</p> + <p> + OTP-12074 in OTP 17.3 missed one case: a length error on + a trailing AVP unknown to the dictionary in question.</p> + <p> + Own Id: OTP-12642</p> + </item> + <item> + <p> + Don't confuse Result-Code and Experimental-Result</p> + <p> + The errors field of a decoded diameter_packet record was + populated with a Result-Code AVP when an + Experimental-Result containing a 3xxx Result-Code was + received in an answer not setting the E-bit. The correct + AVP is now extracted from the incoming message.</p> + <p> + Own Id: OTP-12654 Aux Id: seq12851 </p> + </item> + <item> + <p> + Don't count on unknown Application Id.</p> + <p> + OTP-11721 in OTP 17.1 missed the case of an Application + Id not agreeing with that of the dictionary in question, + causing counters to be accumulated on keys containing the + unknown id.</p> + <p> + Own Id: OTP-12701</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.9</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 0eef218a07..e8ffe7f92c 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -445,7 +445,7 @@ reset(_, _) -> %% undecoded. Note that the type field is 'undefined' in this case. decode_AVP(Name, Avp, {Avps, Acc}) -> - {[Avp | Avps], pack_AVP(Name, Avp, Acc)}. + {[trim(Avp) | Avps], pack_AVP(Name, Avp, Acc)}. %% rc/1 diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 15a4c5e86f..bf2fe8e7ca 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -640,8 +640,12 @@ split_data(Bin, Len) -> %% payload if this is a request. Do this (in cases that we %% know the type) by inducing a decode failure and letting %% the dictionary's decode (in diameter_gen) deal with it. - %% Here we don't know type. If the type isn't known, then - %% the decode just strips the extra bit. + %% + %% Note that the extra bit can only occur in the trailing + %% AVP of a message or Grouped AVP, since a faulty AVP + %% Length is otherwise indistinguishable from a correct + %% one here, since we don't know the types of the AVPs + %% being extracted. {<<0:1, Bin/binary>>, <<>>} end. @@ -690,8 +694,8 @@ pack_avp(#diameter_avp{code = undefined, data = B}) Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>), <<H/binary, Len:24, T/binary>>; -%% ... from a dictionary compiled against old code in diameter_gen ... %% ... when ignoring errors in Failed-AVP ... +%% ... during a relay encode ... pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) -> pack_avp(A#diameter_avp{data = B}); diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 538ebeeeba..ffd2c0afa2 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -980,8 +980,8 @@ answer_message(OH, OR, RC, Dict0, #diameter_packet{avps = Avps, session_id(Code, Vid, Dict0, Avps) when is_list(Avps) -> try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [Dict0:avp(decode, D, 'Session-Id')]}] + #diameter_avp{data = Bin} = find_avp(Code, Vid, Avps), + [{'Session-Id', [Dict0:avp(decode, Bin, 'Session-Id')]}] catch error: _ -> [] @@ -998,26 +998,17 @@ failed_avp(_, [] = No) -> %% find_avp/3 -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). +%% Grouped ... +find_avp(Code, VId, [[#diameter_avp{code = Code, vendor_id = VId} | _] = As + | _]) -> + As; -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. +%% ... or not. +find_avp(Code, VId, [#diameter_avp{code = Code, vendor_id = VId} = A | _]) -> + A; -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. +find_avp(Code, VId, [_ | Avps]) -> + find_avp(Code, VId, Avps). %% 7. Error Handling %% @@ -1086,7 +1077,6 @@ incr_result(_, #diameter_packet{msg = undefined = No}, _, _) -> incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, - msg = Msg, errors = Es} = Pkt, @@ -1096,13 +1086,13 @@ incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), %% Exit on a missing result code. - T = rc_counter(Dict, Msg), + T = rc_counter(Dict, Dir, Pkt), T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}), - {Ctr, RC} = T, + {Ctr, RC, Avp} = T, %% Or on an inappropriate value. is_result(RC, E, Dict0) - orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, RC}), + orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, Avp}), incr(TPid, {Id, Dir, Ctr}), Ctr. @@ -1116,19 +1106,15 @@ msg_id(#diameter_packet{header = H}, Dict) -> %% there are 2^32 (application ids) * 2^24 (command codes) = 2^56 %% pairs for an attacker to choose from. msg_id(Hdr, Dict) -> - {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr), - case Dict:msg_name(Code, 0 == R) of - '' -> - unknown(Dict:id(), R); - _ -> - Id + {Aid, Code, R} = Id = diameter_codec:msg_id(Hdr), + if Aid == ?APP_ID_RELAY -> + {relay, R}; + true -> + choose(Aid /= Dict:id() orelse '' == Dict:msg_name(Code, 0 == R), + unknown, + Id) end. -unknown(?APP_ID_RELAY, R) -> - {relay, R}; -unknown(_, _) -> - unknown. - %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> RC < 3000 orelse 4000 =< RC; @@ -1148,7 +1134,7 @@ is_result(RC, true, _) -> incr(TPid, Counter) -> diameter_stats:incr(Counter, TPid, 1). -%% rc_counter/2 +%% rc_counter/3 %% RFC 3588, 7.6: %% @@ -1156,39 +1142,45 @@ incr(TPid, Counter) -> %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -rc_counter(Dict, Msg) -> - rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))). +rc_counter(Dict, recv, #diameter_packet{header = H, avps = As}) -> + rc_counter(Dict, [H|As]); -rcc(Dict, Msg, undefined) -> - rcc(get_avp_value(Dict, 'Experimental-Result', Msg)); +rc_counter(Dict, _, #diameter_packet{msg = Msg}) -> + rc_counter(Dict, Msg). -rcc(_, _, N) +rc_counter(Dict, Msg) -> + rcc(get_result(Dict, Msg)). + +rcc(#diameter_avp{name = 'Result-Code' = Name, value = N} = A) when is_integer(N) -> - {{'Result-Code', N}, N}. + {{Name, N}, N, A}; -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. +rcc(#diameter_avp{name = 'Result-Code' = Name, value = [N|_]} = A) + when is_integer(N) -> + {{Name, N}, N, A}; -rcc([{_,_,N} = T | _]) +rcc(#diameter_avp{name = 'Experimental-Result', value = {_,_,N} = T} = A) when is_integer(N) -> - {T,N}; -rcc({_,_,N} = T) + {T, N, A}; + +rcc(#diameter_avp{name = 'Experimental-Result', value = [{_,_,N} = T|_]} = A) when is_integer(N) -> - {T,N}; + {T, N, A}; + rcc(_) -> false. -%% Extract the first good looking integer. There's no guarantee -%% that what we're looking for has arity 1. -int([N|_]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. +%% get_result/2 + +get_result(Dict, Msg) -> + try + [throw(A) || N <- ['Result-Code', 'Experimental-Result'], + #diameter_avp{} = A <- [get_avp(Dict, N, Msg)]] + of + [] -> false + catch + #diameter_avp{} = A -> A + end. x(T) -> exit(T). @@ -1528,10 +1520,10 @@ handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> %% a missing AVP. If both are optional in the dictionary %% then this isn't a decode error: just continue on. answer(Pkt, SvcName, App, Req); - exit: {invalid_error_bit, {_, _, _, RC}} -> + exit: {invalid_error_bit, {_, _, _, Avp}} -> #diameter_packet{errors = Es} = Pkt, - E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + E = {5004, Avp}, answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) end. @@ -1868,7 +1860,7 @@ str([]) -> str(T) -> T. -%% get_avp_value/3 +%% get_avp/3 %% %% Find an AVP in a message of one of three forms: %% @@ -1885,47 +1877,71 @@ str(T) -> %% look for are in the common dictionary. This is required since the %% relay dictionary doesn't inherit the common dictionary (which maybe %% it should). -get_avp_value(?RELAY, Name, Msg) -> - get_avp_value(?BASE, Name, Msg); +get_avp(?RELAY, Name, Msg) -> + get_avp(?BASE, Name, Msg); -%% Message sent as a header/avps list, probably a relay case but not -%% necessarily. -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> +%% Message as a header/avps list. +get_avp(Dict, Name, [#diameter_header{} | Avps]) -> try {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) + find_avp(Code, VId, Avps) + of + A -> + avp_decode(Dict, Name, ungroup(A)) catch error: _ -> undefined end; %% Outgoing message as a name/values list. -get_avp_value(_, Name, [_MsgName | Avps]) -> +get_avp(_, Name, [_MsgName | Avps]) -> case lists:keyfind(Name, 1, Avps) of {_, V} -> - V; + #diameter_avp{name = Name, value = V}; _ -> undefined end; %% Message is typically a record but not necessarily. -get_avp_value(Dict, Name, Rec) -> +get_avp(Dict, Name, Rec) -> try - Dict:'#get-'(Name, Rec) + #diameter_avp{name = Name, value = Dict:'#get-'(Name, Rec)} catch error:_ -> undefined end. +%% get_avp_value/3 + +get_avp_value(Dict, Name, Msg) -> + case get_avp(Dict, Name, Msg) of + #diameter_avp{value = V} -> + V; + undefined = No -> + No + end. + +%% ungroup/1 + +ungroup([Avp|_]) -> + Avp; +ungroup(Avp) -> + Avp. + +%% avp_decode/3 + avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. + data = Bin} + = Avp) -> + try Dict:avp(decode, Bin, Name) of + V -> + Avp#diameter_avp{value = V} + catch + error:_ -> + Avp + end; +avp_decode(_, _, #diameter_avp{} = Avp) -> + Avp. cb(#diameter_app{module = [_|_] = M}, F, A) -> eval(M, F, A); diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index d91a776321..d5a9c81b09 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -183,7 +183,7 @@ erl_forms(Mod, ParseD) -> f_enumerated_avp(ParseD), f_empty_value(ParseD), f_dict(ParseD), - {eof, ?LINE}]], + {eof, erl_anno:new(?LINE)}]], lists:append(Forms). diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl index dd03401b9e..04d5834c88 100644 --- a/lib/diameter/src/compiler/diameter_forms.hrl +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-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,8 +28,10 @@ [], [?APPLY(erlang, error, [?ATOM(badarg)])]}). +-define(ANNO(L), erl_anno:new(L)). + %% Form tag with line number. --define(F(T), T, ?LINE). +-define(F(T), T, ?ANNO(?LINE)). %% Yes, that's right. The replacement is to the first unmatched ')'. -define(attribute, ?F(attribute)). @@ -47,10 +49,10 @@ -define(record_index, ?F(record_index)). -define(tuple, ?F(tuple)). --define(ATOM(T), {atom, ?LINE, T}). --define(INTEGER(N), {integer, ?LINE, N}). --define(VAR(V), {var, ?LINE, V}). --define(NIL, {nil, ?LINE}). +-define(ATOM(T), {atom, ?ANNO(?LINE), T}). +-define(INTEGER(N), {integer, ?ANNO(?LINE), N}). +-define(VAR(V), {var, ?ANNO(?LINE), V}). +-define(NIL, {nil, ?ANNO(?LINE)}). -define(CALL(F,A), {?call, ?ATOM(F), A}). -define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index a54eb24031..0ef0fd35a9 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -35,32 +35,10 @@ {"1.4.3", [{restart_application, diameter}]}, %% R16B02 {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, %% R16B03 - {"1.6", [{load_module, diameter_lib}, %% 17.0 - {load_module, diameter_traffic}, - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_service}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}, - {load_module, diameter_codec}, - {load_module, diameter_sctp}]}, - {"1.7", [{load_module, diameter_service}, %% 17.1 - {load_module, diameter_codec}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}, - {load_module, diameter_traffic}, - {load_module, diameter_peer_fsm}]}, - {"1.7.1", [{load_module, diameter_traffic}, %% 17.3 - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_service}]}, - {"1.8", [{load_module, diameter_lib}, %% 17.4 + {"1.6", [{restart_application, diameter}]}, %% 17.0 + {"1.7", [{restart_application, diameter}]}, %% 17.[12] + {<<"^1\\.(7\\.1|8)$">>, %% 17.[34] + [{load_module, diameter_lib}, {load_module, diameter_peer}, {load_module, diameter_reg}, {load_module, diameter_session}, @@ -84,7 +62,14 @@ {load_module, diameter_gen_relay}, {update, diameter_transport_sup, supervisor}, {update, diameter_service_sup, supervisor}, - {update, diameter_sup, supervisor}]} + {update, diameter_sup, supervisor}]}, + {"1.9", [{load_module, diameter_codec}, %% 17.5 + {load_module, diameter_traffic}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_relay}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -102,32 +87,10 @@ {"1.4.3", [{restart_application, diameter}]}, {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, - {"1.6", [{load_module, diameter_sctp}, - {load_module, diameter_codec}, - {load_module, diameter_gen_relay}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_service}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}, - {load_module, diameter_traffic}, - {load_module, diameter_lib}]}, - {"1.7", [{load_module, diameter_peer_fsm}, - {load_module, diameter_traffic}, - {load_module, diameter_gen_relay}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_codec}, - {load_module, diameter_service}]}, - {"1.7.1", [{load_module, diameter_service}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}, - {load_module, diameter_traffic}]}, - {"1.8", [{update, diameter_sup, supervisor}, + {"1.6", [{restart_application, diameter}]}, + {"1.7", [{restart_application, diameter}]}, + {<<"^1\\.(7\\.1|8)$">>, + [{update, diameter_sup, supervisor}, {update, diameter_service_sup, supervisor}, {update, diameter_transport_sup, supervisor}, {load_module, diameter_gen_relay}, @@ -151,6 +114,13 @@ {load_module, diameter_session}, {load_module, diameter_reg}, {load_module, diameter_peer}, - {load_module, diameter_lib}]} + {load_module, diameter_lib}]}, + {"1.9", [{load_module, diameter_gen_relay}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_traffic}, + {load_module, diameter_codec}]} ] }. diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl index 071b1a1177..44fc3a60aa 100644 --- a/lib/diameter/test/diameter_3xxx_SUITE.erl +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -47,6 +47,7 @@ send_double_error/1, send_3xxx/1, send_5xxx/1, + counters/1, stop/1]). %% diameter callbacks @@ -111,7 +112,7 @@ all() -> groups() -> Tc = tc(), - [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + [{?util:name([E,D]), [], [start] ++ Tc ++ [counters, stop]} || E <- ?ERRORS, D <- ?RFCS]. init_per_suite(Config) -> @@ -169,6 +170,203 @@ stop(_Config) -> ok = diameter:stop_service(?SERVER), ok = diameter:stop_service(?CLIENT). +%% counters/1 +%% +%% Check that counters are as expected. + +counters(Config) -> + Group = proplists:get_value(group, Config), + [_Errors, _Rfc] = G = ?util:name(Group), + [] = ?util:run([[fun counters/3, K, S, G] + || K <- [statistics, transport, connections], + S <- [?CLIENT, ?SERVER]]). + +counters(Key, Svc, Group) -> + counters(Key, Svc, Group, [_|_] = diameter:service_info(Svc, Key)). + +counters(statistics, Svc, [Errors, Rfc], L) -> + [{P, Stats}] = L, + true = is_pid(P), + stats(Svc, Errors, Rfc, lists:sort(Stats)); + +counters(_, _, _, _) -> + todo. + +stats(?CLIENT, E, rfc3588, L) + when E == answer; + E == answer_3xxx -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},6}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},1}] + = L; + +stats(?SERVER, E, rfc3588, L) + when E == answer; + E == answer_3xxx -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},6}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, answer, rfc6733, L) -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},3}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, answer, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},3}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, answer_3xxx, rfc6733, L) -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},2}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, answer_3xxx, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},2}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, callback, rfc3588, L) -> + [{{unknown,recv},1}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},6}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},2}] + = L; + +stats(?SERVER, callback, rfc3588, L) -> + [{{unknown,recv},1}, + {{unknown,send},1}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},6}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},2}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, callback, rfc6733, L) -> + [{{unknown,recv},1}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},3}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, callback, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},1}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},3}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L. + %% send_unknown_application/1 %% %% Send an unknown application that a callback (which shouldn't take diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 6975e83830..84f8a66a8a 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -249,11 +249,10 @@ release() -> end. unversion(App) -> - T = lists:dropwhile(fun is_vsn_ch/1, lists:reverse(App)), - lists:reverse(case T of [$-|TT] -> TT; _ -> T end). - -is_vsn_ch(C) -> - $0 =< C andalso C =< $9 orelse $. == C. + {Name, [$-|Vsn]} = lists:splitwith(fun(C) -> C /= $- end, App), + true = is_app(Name), %% assert + Vsn = vsn_str(Vsn), %% + Name. app('$M_EXPR') -> %% could be anything but assume it's ok "erts"; @@ -322,11 +321,11 @@ acc_rel(Dir, Rel, {Vsn, _}, Acc) -> %% Write a rel file and return its name. write_rel(Dir, [Erts | Apps], Vsn) -> - true = is_vsn(Vsn), - Name = "diameter_test_" ++ Vsn, + VS = vsn_str(Vsn), + Name = "diameter_test_" ++ VS, ok = write_file(filename:join([Dir, Name ++ ".rel"]), {release, - {"diameter " ++ Vsn ++ " test release", Vsn}, + {"diameter " ++ VS ++ " test release", VS}, Erts, Apps}), Name. @@ -341,10 +340,34 @@ fetch(Key, List) -> write_file(Path, T) -> file:write_file(Path, io_lib:format("~p.", [T])). -%% Is a version string of the expected form? Return the argument -%% itself for 'false' for a useful badmatch. +%% Is a version string of the expected form? is_vsn(V) -> - is_list(V) - andalso length(V) == string:span(V, "0123456789.") - andalso V == string:join(string:tokens(V, [$.]), ".") %% no ".." - orelse {error, V}. + V = vsn_str(V), + true. + +%% Turn a from/to version in appup to a version string after ensuring +%% that it's valid version number of regexp. In the regexp case, the +%% regexp itself becomes the version string since there's no +%% requirement that a version in appup be anything but a string. The +%% restrictions placed on string-valued version numbers (that they be +%% '.'-separated integers) are our own. + +vsn_str(S) + when is_list(S) -> + {_, match} = {S, match(S, "^(0|[1-9][0-9]*)(\\.(0|[1-9][0-9]*))*$")}, + {_, nomatch} = {S, match(S, "\\.0\\.0$")}, + S; + +vsn_str(B) + when is_binary(B) -> + {ok, _} = re:compile(B), + binary_to_list(B). + +match(S, RE) -> + re:run(S, RE, [{capture, none}]). + +%% Is an application name of the expected form? +is_app(S) + when is_list(S) -> + {_, match} = {S, match(S, "^([a-z]([a-z_]*|[a-zA-Z]*))$")}, + true. diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index 02501ce779..1c0f25864c 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -378,10 +378,14 @@ dict(N) -> %% id's, failing with app_not_configured if it can't. load_dict(N) -> Mod = dict(N), - Forms = [{attribute, 1, module, Mod}, - {attribute, 2, compile, [export_all]}, - {function, 3, id, 0, - [{clause, 4, [], [], [{integer, 4, N}]}]}], + A1 = erl_anno:new(1), + A2 = erl_anno:new(2), + A3 = erl_anno:new(3), + A4 = erl_anno:new(4), + Forms = [{attribute, A1, module, Mod}, + {attribute, A2, compile, [export_all]}, + {function, A3, id, 0, + [{clause, A4, [], [], [{integer, A4, N}]}]}], {ok, Mod, Bin, []} = compile:forms(Forms, [return]), {module, Mod} = code:load_binary(Mod, Mod, Bin), N = Mod:id(). diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 7dd9f39f85..7ff6ba7ab9 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -41,6 +41,7 @@ send_eval/1, send_bad_answer/1, send_protocol_error/1, + send_experimental_result/1, send_arbitrary/1, send_unknown/1, send_unknown_short/1, @@ -301,6 +302,7 @@ tc() -> send_eval, send_bad_answer, send_protocol_error, + send_experimental_result, send_arbitrary, send_unknown, send_unknown_short, @@ -443,7 +445,7 @@ send_ok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 1}], - ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server answers badly to. @@ -459,7 +461,7 @@ send_eval(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 3}], - ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server tries to answer with an @@ -480,12 +482,20 @@ send_protocol_error(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). +%% Send a 3xxx Experimental-Result in an answer not setting the E-bit +%% and missing a Result-Code. +send_experimental_result(Config) -> + Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, + {'Accounting-Record-Number', 5}], + ['ACA', {'Session-Id', _} | _] + = call(Config, Req). + %% Send an ASR with an arbitrary non-mandatory AVP and expect success %% and the same AVP in the reply. send_arbitrary(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name', value = "XXX"}]}], - ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), {'AVP', [#diameter_avp{name = 'Product-Name', value = V}]} @@ -497,7 +507,7 @@ send_unknown(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = false, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), {'AVP', [#diameter_avp{code = 999, is_mandatory = false, @@ -513,7 +523,7 @@ send_unknown_short(Config, M, RC) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = M, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', RC} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', RC} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -527,7 +537,7 @@ send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -547,7 +557,7 @@ send_unexpected_mandatory_decode(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout is_mandatory = true, data = <<12:32>>}]}], - ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -583,7 +593,7 @@ send_error_bit(Config) -> %% Send a bad version and check that we get 5011. send_unsupported_version(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?UNSUPPORTED_VERSION} | _] = call(Config, Req). %% Send a request containing an AVP length > data size. @@ -603,14 +613,14 @@ send_zero_avp_length(Config) -> send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, + ['STA', {'Session-Id', _}, {'Result-Code', ?INVALID_AVP_LENGTH}, - _OriginHost, - _OriginRealm, - _UserName, - _Class, - _ErrorMessage, - _ErrorReportingHost, + {'Origin-Host', _}, + {'Origin-Realm', _}, + {'User-Name', _}, + {'Class', _}, + {'Error-Message', _}, + {'Error-Reporting-Host', _}, {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]} | _] = call(Config, Req). @@ -628,14 +638,14 @@ send_invalid_reject(Config) -> send_unexpected_mandatory(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | _] = call(Config, Req). %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'User-Name', [lists:duplicate(1 bsl 20, $X)]}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send something longer than the configure incoming_maxlen. @@ -677,7 +687,7 @@ send_any_2(Config) -> send_all_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM), - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> @@ -697,9 +707,8 @@ send_timeout(Config) -> %% received the Session-Id. send_error(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}], - ?answer_message(SId, ?TOO_BUSY) - = call(Config, Req), - true = undefined /= SId. + ?answer_message([_], ?TOO_BUSY) + = call(Config, Req). %% Send a request with the detached option and receive it as a message %% from handle_answer instead. @@ -708,7 +717,7 @@ send_detach(Config) -> Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), Ans = receive {Ref, T} -> T end, - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = Ans. %% Send a request which can't be encoded and expect {error, encode}. @@ -721,11 +730,11 @@ send_destination_1(Config) -> = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(SN, ?REALM)]}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). %% Send with filtering on and expect failure when specifying an @@ -789,7 +798,7 @@ send_bad_filter(Config, F) -> %% Specify multiple filter options and expect them be conjunctive. send_multiple_filters_1(Config) -> Fun = fun(#diameter_caps{}) -> true end, - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [host, {eval, Fun}]). send_multiple_filters_2(Config) -> E = {erlang, is_tuple, []}, @@ -800,7 +809,7 @@ send_multiple_filters_3(Config) -> E2 = {erlang, is_tuple, []}, E3 = {erlang, is_record, [diameter_caps]}, E4 = [{erlang, is_record, []}, diameter_caps], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]). send_multiple_filters(Config, Fs) -> @@ -811,7 +820,7 @@ send_multiple_filters(Config, Fs) -> %% only the return value from the prepare_request callback being %% significant. send_anything(Config) -> - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, anything). %% =========================================================================== @@ -1144,6 +1153,13 @@ answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)), [Dict:rec2msg(R) | Vs]. +%% Missing Result-Codec and inapproriate Experimental-Result-Code. +answer(Rec, Es, send_experimental_result) -> + [{5004, #diameter_avp{name = 'Experimental-Result'}}, + {5005, #diameter_avp{name = 'Result-Code'}}] + = Es, + Rec; + %% An inappropriate E-bit results in a decode error ... answer(Rec, Es, send_bad_answer) -> [{5004, #diameter_avp{name = 'Result-Code'}} | _] = Es, @@ -1175,7 +1191,9 @@ handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) -> %% Note that diameter will set Result-Code and Failed-AVPs if %% #diameter_packet.errors is non-null. -handle_request(#diameter_packet{header = H, msg = M}, _, {_Ref, Caps}) -> +handle_request(#diameter_packet{header = H, msg = M, avps = As}, + _, + {_Ref, Caps}) -> #diameter_header{end_to_end_id = EI, hop_by_hop_id = HI} = H, @@ -1183,10 +1201,12 @@ handle_request(#diameter_packet{header = H, msg = M}, _, {_Ref, Caps}) -> V = EI bsr B, %% assert V = HI bsr B, %% #diameter_caps{origin_state_id = {_,[Id]}} = Caps, - answer(origin(Id), request(M, Caps)). + answer(origin(Id), request(M, [H|As], Caps)). answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; +answer(_, {reply, [#diameter_header{} | _]} = T) -> + T; answer({A,C}, {reply, Ans}) -> answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); answer(pkt, {reply, Ans}) @@ -1195,6 +1215,41 @@ answer(pkt, {reply, Ans}) answer(_, T) -> T. +%% request/3 + +%% send_experimental_result +request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 5}, + [Hdr | Avps], + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}}) -> + [H,R|T] = [A || N <- ['Origin-Host', + 'Origin-Realm', + 'Session-Id', + 'Accounting-Record-Type', + 'Accounting-Record-Number'], + #diameter_avp{} = A + <- [lists:keyfind(N, #diameter_avp.name, Avps)]], + Ans = [Hdr#diameter_header{is_request = false}, + H#diameter_avp{data = OH}, + R#diameter_avp{data = OR}, + #diameter_avp{name = 'Experimental-Result', + code = 297, + need_encryption = false, + data = [#diameter_avp{data = {?DIAMETER_DICT_COMMON, + 'Vendor-Id', + 123}}, + #diameter_avp{data + = {?DIAMETER_DICT_COMMON, + 'Experimental-Result-Code', + 3987}}]} + | T], + {reply, Ans}; + +request(Msg, _Avps, Caps) -> + request(Msg, Caps). + +%% request/2 + %% send_nok request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0}, _) -> diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index c00bac26bb..db7f72c44e 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -16,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.9 +DIAMETER_VSN = 1.9.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 88e7ab5346..90f1fc3071 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -689,13 +689,12 @@ scan_and_parse(Epp) -> fix_last_line(Toks0) -> Toks1 = lists:reverse(Toks0), - {line, LastLine} = erl_scan:token_info(hd(Toks1), line), + LastLine = erl_scan:line(hd(Toks1)), fll(Toks1, LastLine, []). -fll([{Category, Attributes0, Symbol} | L], LastLine, Ts) -> - F = fun(_OldLine) -> LastLine end, - Attributes = erl_scan:set_attribute(line, Attributes0, F), - lists:reverse(L, [{Category, Attributes, Symbol} | Ts]); +fll([{Category, Anno0, Symbol} | L], LastLine, Ts) -> + Anno = erl_anno:set_line(LastLine, Anno0), + lists:reverse(L, [{Category, Anno, Symbol} | Ts]); fll([T | L], LastLine, Ts) -> fll(L, LastLine, [T | Ts]); fll(L, _LastLine, Ts) -> diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 6309e88475..62d5eb9a18 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -535,7 +535,8 @@ t_clause(Name, Type) -> pp_clause(Pre, Type) -> Types = ot_utype([Type]), Atom = lists:duplicate(iolist_size(Pre), $a), - L1 = erl_pp:attribute({attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}), + Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), "-spec " ++ L2 = lists:flatten(L1), L3 = Pre ++ lists:nthtail(length(Atom), L2), re:replace(L3, "\n ", "\n", [{return,list},global]). @@ -555,7 +556,8 @@ format_type(Prefix, _Name, Type, Last, _Opts) -> pp_type(Prefix, Type) -> Atom = list_to_atom(lists:duplicate(iolist_size(Prefix), $a)), - L1 = erl_pp:attribute({attribute,0,type,{Atom,ot_utype(Type),[]}}), + Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":" "::\n" ++ L3 -> {"\n"++L3,6} @@ -1085,8 +1087,8 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [Atom], _} = erl_scan:string(get_attrval(value, E), 0), - Atom. + {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), + {atom,erl_anno:line(A),Name}. ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index c248964dc4..dcc239f6b4 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -1012,7 +1012,7 @@ get_plugin(Key, Default, Opts) -> %% --------------------------------------------------------------------- %% Error handling --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -type err() :: 'eof' | {'missing', char()} | {line(), atom(), string()} diff --git a/lib/edoc/src/edoc_macros.erl b/lib/edoc/src/edoc_macros.erl index bdcb3fe81f..e1a54d5090 100644 --- a/lib/edoc/src/edoc_macros.erl +++ b/lib/edoc/src/edoc_macros.erl @@ -311,7 +311,7 @@ macro_content([C | Cs], As, L, N) -> macro_content([], _As, _L, _N) -> throw('end'). --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -type err() :: 'unterminated_macro' | 'macro_name' | {'macro_name', string()} diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index 48c01c8dce..835e7ccaa6 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -338,7 +338,7 @@ build_def(S, P, As, T) -> args = lists:reverse(As)}, type = T}; false -> - return_error(element(2, P), "variable expected after '('") + return_error(tok_line(P), "variable expected after '('") end. all_vars([#t_var{} | As]) -> @@ -452,7 +452,7 @@ parse_throws(S, L) -> %% --------------------------------------------------------------------- --spec throw_error(term(), erl_scan:line()) -> no_return(). +-spec throw_error(term(), erl_anno:line()) -> no_return(). throw_error({parse_spec, E}, L) -> throw_error({"specification", E}, L); diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 3bf81c6503..59f6cb8ddf 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -58,7 +58,7 @@ type(Form, TypeDocs) -> end, {#t_name{name = N}, T, As, Doc0} end, - #tag{name = type, line = element(2, Type), + #tag{name = type, line = get_line(element(2, Type)), origin = code, data = {#t_typedef{name = TypeName, args = d2e(Args), @@ -71,7 +71,7 @@ type(Form, TypeDocs) -> spec(Form, Clause) -> {Name, _Arity, TypeSpecs} = get_spec(Form), TypeSpec = lists:nth(Clause, TypeSpecs), - #tag{name = spec, line = element(2, TypeSpec), + #tag{name = spec, line = get_line(element(2, TypeSpec)), origin = code, data = aspec(d2e(TypeSpec), Name)}. @@ -83,7 +83,7 @@ dummy_spec(Form) -> {#t_name{name = Name}, Arity, TypeSpecs} = get_spec(Form), As = string:join(lists:duplicate(Arity, "_X"), ","), S = lists:flatten(io_lib:format("~p(~s) -> true\n", [Name, As])), - #tag{name = spec, line = element(2, hd(TypeSpecs)), + #tag{name = spec, line = get_line(element(2, hd(TypeSpecs))), origin = code, data = S}. -spec docs(Forms::[syntaxTree()], @@ -140,7 +140,7 @@ find_type_docs([F | Fs], Cs, Fun) -> %% Postcomments before the dot after the typespec are ignored. C2 = [C1 | [C || C <- erl_syntax:get_postcomments(F), - get_line(erl_syntax:get_pos(C)) >= LastTypeLine]], + erl_syntax:get_pos(C) >= LastTypeLine]], C3 = collect_comments(Fs, LastTypeLine), #tag{data = Doc0} = Fun(lists:reverse(C2 ++ C3), LastTypeLine), case strip(Doc0) of % Strip away "f(). \n" @@ -157,7 +157,7 @@ find_type_docs([F | Fs], Cs, Fun) -> collect_comments([], _Line) -> []; collect_comments([F | Fs], Line) -> - L1 = get_line(erl_syntax:get_pos(F)), + L1 = erl_syntax:get_pos(F), if L1 =:= Line + 1; L1 =:= Line -> % a separate postcomment @@ -190,29 +190,26 @@ get_name_and_last_line(F) -> {Name, Data} = erl_syntax_lib:analyze_wild_attribute(F), type = edoc_specs:tag(Name), Attr = {attribute, erl_syntax:get_pos(F), Name, Data}, - Ref = make_ref(), - Fun = fun(L) -> {Ref, get_line(L)} end, + Fun = fun(A) -> + Line = get_line(A), + case get('$max_line') of + Max when Max < Line -> + _ = put('$max_line', Line); + _ -> + ok + end + end, + undefined = put('$max_line', 0), + _ = erl_parse:map_anno(Fun, Attr), + Line = erase('$max_line'), TypeName = case Data of {N, _T, As} when is_atom(N) -> % skip records {N, length(As)} end, - Line = gll(erl_lint:modify_line(Attr, Fun), Ref), {TypeName, Line}. -gll({Ref, Line}, Ref) -> - Line; -gll([], _Ref) -> - 0; -gll(List, Ref) when is_list(List) -> - lists:max([gll(E, Ref) || E <- List]); -gll(Tuple, Ref) when is_tuple(Tuple) -> - gll(tuple_to_list(Tuple), Ref); -gll(_, _) -> - 0. - -get_line(Pos) -> - {line, Line} = erl_scan:attributes_info(Pos, line), - Line. +get_line(Anno) -> + erl_anno:line(Anno). %% Collect all Erlang types. Types in comments (@type) shadow Erlang %% types (-spec/-opaque). @@ -348,7 +345,7 @@ d2e({type,_,constraint,[Sub,Ts0]}) -> Ts = [ST,T] = d2e([ST0,T0]), #t_def{name = ST, type = typevar_anno(T, Ts)}; _ -> - throw_error(element(2, Sub), "cannot handle guard", []) + throw_error(get_line(element(2, Sub)), "cannot handle guard", []) end; d2e({type,_,union,Ts0}) -> Ts = d2e(Ts0), diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index c1c453511a..9e2e41e902 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -342,7 +342,7 @@ parse_typedef(Data, Line, _Env, Where) -> Def end. --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -spec parse_file(_, line(), _, _) -> no_return(). diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index adca41ed63..105a2bcdbb 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.1.1 +ELDAP_VSN = 1.2 diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index 2aae87a759..0b531db701 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -126,6 +126,11 @@ span.code { font-family: Courier, monospace; font-weight: normal } background-color:#eeeeff; padding: 0px 10px; } +.extrafrontpageinfo { + color: #C00; + font-weight: bold; + font-size: 120%; +} pre { font-family: Courier, monospace; font-weight: normal } diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 3b390f48fb..3529924957 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -1132,6 +1132,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="chapter"/> @@ -1297,6 +1300,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="erlref|cref|comref|fileref|appref"/> @@ -2119,6 +2125,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="chapter"/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 8e7ffddefa..ccf96053aa 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -671,6 +671,10 @@ <fo:block xsl:use-attribute-sets="cover.version"> <xsl:value-of select="$gendate"/> </fo:block> + <fo:block xsl:use-attribute-sets="cover.extrainfo"> + <xsl:value-of select="$extra_front_page_info"/> + </fo:block> + <!-- Inner cover (copyright notice) --> <fo:block break-before="page" diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl index c2d9fb4320..a4814581c2 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl @@ -98,6 +98,14 @@ <xsl:attribute name="text-align">end</xsl:attribute> </xsl:attribute-set> + <xsl:attribute-set name="cover.extrainfo"> + <xsl:attribute name="padding-before">2.5em</xsl:attribute> + <xsl:attribute name="font-size">1.33em</xsl:attribute> + <xsl:attribute name="font-weight">bold</xsl:attribute> + <xsl:attribute name="color">#C00</xsl:attribute> + <xsl:attribute name="text-align">end</xsl:attribute> + </xsl:attribute-set> + <xsl:attribute-set name="cover.inner.copyright"> <xsl:attribute name="border-before-style">solid</xsl:attribute> <xsl:attribute name="border-before-width">1pt</xsl:attribute> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index e2eee2b3c0..b62e69529b 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -202,7 +202,8 @@ t_clause(Name, Type) -> pp_clause(Pre, Type) -> Types = ot_utype([Type]), Atom = lists:duplicate(iolist_size(Pre), $a), - L1 = erl_pp:attribute({attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}), + Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), "-spec " ++ L2 = lists:flatten(L1), L3 = Pre ++ lists:nthtail(length(Atom), L2), re:replace(L3, "\n ", "\n", [{return,list},global]). @@ -222,7 +223,8 @@ format_type(_Name, Type, _Opts) -> pp_type(Prefix, Type) -> Atom = list_to_atom(lists:duplicate(iolist_size(Prefix), $a)), - L1 = erl_pp:attribute({attribute,0,type,{Atom,ot_utype(Type),[]}}), + Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":" "::\n" ++ L3 -> {"\n"++L3,6} @@ -569,8 +571,8 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [Atom], _} = erl_scan:string(get_attrval(value, E), 0), - Atom. + {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), + {atom,erl_anno:line(A),Name}. ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index 8957d6ac40..5823c96253 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.3.7 +ERL_DOCGEN_VSN = 0.3.8 diff --git a/lib/eunit/src/eunit_autoexport.erl b/lib/eunit/src/eunit_autoexport.erl index 36ae3b71d7..7bb78f5ea8 100644 --- a/lib/eunit/src/eunit_autoexport.erl +++ b/lib/eunit/src/eunit_autoexport.erl @@ -79,11 +79,12 @@ rewrite([{function,_,test,0,_}=F | Fs], As, Module, _Test) -> rewrite([F | Fs], As, Module, Test) -> rewrite(Fs, [F | As], Module, Test); rewrite([], As, Module, Test) -> + L = erl_anno:new(0), {if Test -> - [{function,0,test,0, - [{clause,0,[],[], - [{call,0,{remote,0,{atom,0,eunit},{atom,0,test}}, - [{atom,0,Module}]}]}]} + [{function,L,test,0, + [{clause,L,[],[], + [{call,L,{remote,L,{atom,L,eunit},{atom,L,test}}, + [{atom,L,Module}]}]}]} | As]; true -> As @@ -96,4 +97,4 @@ module_decl(Name, M, Fs, Exports) -> Es = if Test -> [{test,0} | Exports]; true -> Exports end, - [M, {attribute,0,export,Es} | lists:reverse(Fs1)]. + [M, {attribute,erl_anno:new(0),export,Es} | lists:reverse(Fs1)]. diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 2645056be1..f98aaa12f3 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -110,7 +110,7 @@ effect = false :: boolean(), fail = [], % [] or fail-to label class = expr :: 'expr' | 'guard', - line = 0 :: erl_scan:line(), % current line number + line = 0 :: erl_anno:line(), % current line number 'receive' :: 'undefined' | #'receive'{} }). 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/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index af8903904b..a36a024980 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -697,13 +697,22 @@ get_binary_bytes(Binary, BinSize, Base, Offset, Orig, %%%%%%%%%%%%%%%%%%%%%%%%% UTILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_base(Orig,Base) -> - [HeapLbl,REFCLbl,EndLbl] = create_lbls(3), + [HeapLbl,REFCLbl,WritableLbl,NotWritableLbl,EndLbl] = create_lbls(5), + Flags = hipe_rtl:mk_new_reg_gcsafe(), + [hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)), REFCLbl, + get_field_from_term({proc_bin, flags}, Orig, Flags), + hipe_rtl:mk_branch(Flags, 'ne', hipe_rtl:mk_imm(0), + hipe_rtl:label_name(WritableLbl), + hipe_rtl:label_name(NotWritableLbl)), + WritableLbl, + hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'), + NotWritableLbl, hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)), EndLbl]. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl index 8194d878b8..7bc93a316b 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_match.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl @@ -12,7 +12,8 @@ test() -> Funs = [fun test_aligned/0, fun test_unaligned/0, - fun test_zero_tail/0, fun test_integer_matching/0], + fun test_zero_tail/0, fun test_integer_matching/0, + fun test_writable_bin/0], lists:foreach(fun (F) -> ok = F() end, Funs). %%------------------------------------------------------------------- @@ -173,3 +174,14 @@ test_dynamic_integer_matching(N) -> <<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>, <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>, ok. + +test_writable_bin() -> + test_writable_bin(<<>>, 0), + ok. + +test_writable_bin(Bin, 128) -> + Bin; +test_writable_bin(Bin0, N) when N < 128 -> + Bin1 = <<Bin0/binary, N>>, + <<_/utf8, _/binary>> = Bin1, + test_writable_bin(Bin1, N+1). diff --git a/lib/inets/src/inets_app/inets_lib.erl b/lib/inets/src/inets_app/inets_lib.erl index e79959f678..fa6adaebd0 100644 --- a/lib/inets/src/inets_app/inets_lib.erl +++ b/lib/inets/src/inets_app/inets_lib.erl @@ -26,7 +26,7 @@ %% Help function, elapsed milliseconds since T0 millisec_passed({_,_,_} = T0 ) -> %% OTP 17 and earlier - timer:now_diff(inets_time_compat:monotonic_time(), T0) div 1000; + timer:now_diff(inets_time_compat:timestamp(), T0) div 1000; millisec_passed(T0) -> %% OTP 18 diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java index 990e50ddcd..268261ec10 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java @@ -297,6 +297,54 @@ public class OtpErlangList extends OtpErlangObject implements return getLastTail().equals(l.getLastTail()); } + @Override + public <T> boolean match(final OtpErlangObject term, final T bindings) { + if (!(term instanceof OtpErlangList)) { + return false; + } + final OtpErlangList that = (OtpErlangList) term; + + final int thisArity = this.arity(); + final int thatArity = that.arity(); + final OtpErlangObject thisTail = this.getLastTail(); + final OtpErlangObject thatTail = that.getLastTail(); + + if (thisTail == null) { + if (thisArity != thatArity || thatTail != null) { + return false; + } + } else { + if (thisArity > thatArity) { + return false; + } + } + for (int i = 0; i < thisArity; i++) { + if (!elementAt(i).match(that.elementAt(i), bindings)) { + return false; + } + } + if (thisTail == null) { + return true; + } + return thisTail.match(that.getNthTail(thisArity), bindings); + } + + @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangList list = (OtpErlangList) this.clone(); + + final int a = list.elems.length; + for (int i = 0; i < a; i++) { + list.elems[i] = list.elems[i].bind(binds); + } + + if (list.lastTail != null) { + list.lastTail = list.lastTail.bind(binds); + } + + return list; + } + public OtpErlangObject getLastTail() { return lastTail; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java index 7f2621923a..a8cd9d5392 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -18,6 +18,11 @@ */ package com.ericsson.otp.erlang; +import java.util.HashMap; +import java.util.Map; +import java.util.Map.Entry; +import java.util.Set; + /** * Provides a Java representation of Erlang maps. Maps are created from one or * more arbitrary Erlang terms. @@ -31,10 +36,14 @@ public class OtpErlangMap extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -6410770117696198497L; - private static final OtpErlangObject[] NO_ELEMENTS = new OtpErlangObject[0]; + private HashMap<OtpErlangObject, OtpErlangObject> map; - private OtpErlangObject[] keys = NO_ELEMENTS; - private OtpErlangObject[] values = NO_ELEMENTS; + /** + * Create an empty map. + */ + public OtpErlangMap() { + map = new HashMap<OtpErlangObject, OtpErlangObject>(); + } /** * Create a map from an array of keys and an array of values. @@ -82,30 +91,20 @@ public class OtpErlangMap extends OtpErlangObject { } else if (kcount != vcount) { throw new java.lang.IllegalArgumentException( "Map keys and values must have same arity"); - } else if (vcount < 1) { - this.keys = NO_ELEMENTS; - this.values = NO_ELEMENTS; - } else { - this.keys = new OtpErlangObject[vcount]; - for (int i = 0; i < vcount; i++) { - if (keys[kstart + i] != null) { - this.keys[i] = keys[kstart + i]; - } else { - throw new java.lang.IllegalArgumentException( - "Map key cannot be null (element" + (kstart + i) - + ")"); - } + } + map = new HashMap<OtpErlangObject, OtpErlangObject>(vcount); + OtpErlangObject key, val; + for (int i = 0; i < vcount; i++) { + if ((key = keys[kstart + i]) == null) { + throw new java.lang.IllegalArgumentException( + "Map key cannot be null (element" + (kstart + i) + ")"); } - this.values = new OtpErlangObject[vcount]; - for (int i = 0; i < vcount; i++) { - if (values[vstart + i] != null) { - this.values[i] = values[vstart + i]; - } else { - throw new java.lang.IllegalArgumentException( - "Map value cannot be null (element" + (vstart + i) - + ")"); - } + if ((val = values[vstart + i]) == null) { + throw new java.lang.IllegalArgumentException( + "Map value cannot be null (element" + (vstart + i) + + ")"); } + put(key, val); } } @@ -125,16 +124,15 @@ public class OtpErlangMap extends OtpErlangObject { final int arity = buf.read_map_head(); if (arity > 0) { - keys = new OtpErlangObject[arity]; - values = new OtpErlangObject[arity]; - + map = new HashMap<OtpErlangObject, OtpErlangObject>(arity); for (int i = 0; i < arity; i++) { - keys[i] = buf.read_any(); - values[i] = buf.read_any(); + OtpErlangObject key, val; + key = buf.read_any(); + val = buf.read_any(); + put(key, val); } } else { - keys = NO_ELEMENTS; - values = NO_ELEMENTS; + map = new HashMap<OtpErlangObject, OtpErlangObject>(); } } @@ -144,7 +142,33 @@ public class OtpErlangMap extends OtpErlangObject { * @return the number of elements contained in the map. */ public int arity() { - return keys.length; + return map.size(); + } + + /** + * Put value corresponding to key into the map. For detailed behavior + * description see {@link Map#put(Object, Object)}. + * + * @param key + * key to associate value with + * @param value + * value to associate with key + * @return previous value associated with key or null + */ + public OtpErlangObject put(final OtpErlangObject key, + final OtpErlangObject value) { + return map.put(key, value); + } + + /** + * removes mapping for the key if present. + * + * @param key + * key for which mapping is to be remove + * @return value associated with key or null + */ + public OtpErlangObject remove(final OtpErlangObject key) { + return map.remove(key); } /** @@ -156,15 +180,7 @@ public class OtpErlangMap extends OtpErlangObject { * @return the requested value, of null if key is not a valid key. */ public OtpErlangObject get(final OtpErlangObject key) { - if (key == null) { - return null; - } - for (int i = 0; i < keys.length; i++) { - if (key.equals(keys[i])) { - return values[i]; - } - } - return null; + return map.get(key); } /** @@ -173,9 +189,7 @@ public class OtpErlangMap extends OtpErlangObject { * @return an array containing all of the map's keys. */ public OtpErlangObject[] keys() { - final OtpErlangObject[] res = new OtpErlangObject[arity()]; - System.arraycopy(keys, 0, res, 0, res.length); - return res; + return map.keySet().toArray(new OtpErlangObject[arity()]); } /** @@ -184,9 +198,16 @@ public class OtpErlangMap extends OtpErlangObject { * @return an array containing all of the map's values. */ public OtpErlangObject[] values() { - final OtpErlangObject[] res = new OtpErlangObject[arity()]; - System.arraycopy(values, 0, res, 0, res.length); - return res; + return map.values().toArray(new OtpErlangObject[arity()]); + } + + /** + * make Set view of the map key-value pairs + * + * @return a set containing key-value pairs + */ + public Set<Entry<OtpErlangObject, OtpErlangObject>> entrySet() { + return map.entrySet(); } /** @@ -196,19 +217,20 @@ public class OtpErlangMap extends OtpErlangObject { */ @Override public String toString() { - int i; final StringBuffer s = new StringBuffer(); - final int arity = values.length; s.append("#{"); - for (i = 0; i < arity; i++) { - if (i > 0) { + boolean first = true; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + if (first) { + first = false; + } else { s.append(","); } - s.append(keys[i].toString()); + s.append(e.getKey().toString()); s.append(" => "); - s.append(values[i].toString()); + s.append(e.getValue().toString()); } s.append("}"); @@ -224,13 +246,13 @@ public class OtpErlangMap extends OtpErlangObject { */ @Override public void encode(final OtpOutputStream buf) { - final int arity = values.length; + final int arity = arity(); buf.write_map_head(arity); - for (int i = 0; i < arity; i++) { - buf.write_any(keys[i]); - buf.write_any(values[i]); + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + buf.write_any(e.getKey()); + buf.write_any(e.getValue()); } } @@ -256,15 +278,46 @@ public class OtpErlangMap extends OtpErlangObject { if (a != t.arity()) { return false; } + if (a == 0) { + return true; + } - for (int i = 0; i < a; i++) { - if (!keys[i].equals(t.keys[i])) { - return false; // early exit + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + final OtpErlangObject v = t.get(key); + if (v == null || !val.equals(v)) { + return false; } } - for (int i = 0; i < a; i++) { - if (!values[i].equals(t.values[i])) { - return false; // early exit + + return true; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + if (!(term instanceof OtpErlangMap)) { + return false; + } + + final OtpErlangMap t = (OtpErlangMap) term; + final int a = arity(); + + if (a > t.arity()) { + return false; + } + if (a == 0) { + return true; + } + + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + final OtpErlangObject v = t.get(key); + if (v == null || !val.match(v, binds)) { + return false; } } @@ -272,23 +325,31 @@ public class OtpErlangMap extends OtpErlangObject { } @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangMap ret = new OtpErlangMap(); + + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + ret.put(key, val.bind(binds)); + } + + return ret; + } + + @Override protected int doHashCode() { final OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); - final int a = arity(); - hash.combine(a); - for (int i = 0; i < a; i++) { - hash.combine(keys[i].hashCode()); - } - for (int i = 0; i < a; i++) { - hash.combine(values[i].hashCode()); - } + hash.combine(map.hashCode()); return hash.valueOf(); } @Override + @SuppressWarnings("unchecked") public Object clone() { final OtpErlangMap newMap = (OtpErlangMap) super.clone(); - newMap.values = values.clone(); + newMap.map = (HashMap<OtpErlangObject, OtpErlangObject>) map.clone(); return newMap; } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java index 7ab160bcdd..9339d3749b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java @@ -80,6 +80,32 @@ public abstract class OtpErlangObject implements Serializable, Cloneable { @Override public abstract boolean equals(Object o); + /** + * Perform match operation against given term. + * + * @param term + * the object to match + * @param binds + * variable bindings + * @return true if match succeeded + */ + public <T> boolean match(final OtpErlangObject term, final T binds) { + return equals(term); + } + + /** + * Make new Erlang term replacing variables with the respective values from + * bindings argument(s). + * + * @param binds + * variable bindings + * @return new term + * @throws OtpErlangException + */ + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + return this; + } + @Override public int hashCode() { if (hashCodeValue == 0) { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java index af2559e62e..ef0a453de1 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java @@ -236,6 +236,35 @@ public class OtpErlangTuple extends OtpErlangObject { } @Override + public <T> boolean match(final OtpErlangObject term, final T bindings) { + if (!(term instanceof OtpErlangTuple)) { + return false; + } + final OtpErlangTuple t = (OtpErlangTuple) term; + final int a = elems.length; + if (a != t.elems.length) { + return false; + } + for (int i = 0; i < a; i++) { + if (!elems[i].match(t.elems[i], bindings)) { + return false; + } + } + return true; + } + + @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangTuple tuple = (OtpErlangTuple) this.clone(); + final int a = tuple.elems.length; + for (int i = 0; i < a; i++) { + final OtpErlangObject e = tuple.elems[i]; + tuple.elems[i] = e.bind(binds); + } + return tuple; + } + + @Override protected int doHashCode() { final OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); final int a = arity(); diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index 3743e763c5..73bab98559 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -40,7 +40,8 @@ status_handler_localStatus/1, status_handler_remoteStatus/1, status_handler_connAttempt/1, maps/1, - fun_equals/1 + fun_equals/1, + core_match_bind/1 ]). -include_lib("common_test/include/ct.hrl"). @@ -110,7 +111,8 @@ fundamental() -> get_names, % GetNames.java boolean_atom, % BooleanAtom.java maps, % Maps.java - fun_equals % FunEquals.java + fun_equals, % FunEquals.java + core_match_bind % CoreMatchBind.java ]. ping() -> @@ -717,6 +719,18 @@ fun_equals(Config) when is_list(Config) -> []). %%%----------------------------------------------------------------- +core_match_bind(doc) -> + ["CoreMatchBind.java: " + "Test OtpErlangObject.match() and bind()"]; +core_match_bind(suite) -> + []; +core_match_bind(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "CoreMatchBind", + []). + +%%%----------------------------------------------------------------- %%% INTERNAL FUNCTIONS %%%----------------------------------------------------------------- send_receive(TestCaseTag,Fun,Config) -> diff --git a/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java b/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java new file mode 100644 index 0000000000..a78a63093e --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java @@ -0,0 +1,584 @@ +/* + * %CopyrightBegin% + * + * 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 + * 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% + */ + +import com.ericsson.otp.erlang.OtpErlangException; +import com.ericsson.otp.erlang.OtpErlangInt; +import com.ericsson.otp.erlang.OtpErlangList; +import com.ericsson.otp.erlang.OtpErlangMap; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangTuple; +import com.ericsson.otp.erlang.OtpOutputStream; + +public class CoreMatchBind { + + @SuppressWarnings("serial") + private static class DumbObject extends OtpErlangObject { + + @Override + public String toString() { + return this.getClass().getSimpleName(); + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + } + + @SuppressWarnings("serial") + private static class BoundObject extends OtpErlangObject { + + @Override + public String toString() { + return this.getClass().getSimpleName(); + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + } + + @SuppressWarnings("serial") + private static class TestObject extends OtpErlangObject { + + private final Binder binder; + private DumbObject dumb; + private boolean flag; + private BoundObject obj; + + public TestObject(final boolean flag, final Binder binder, + final DumbObject dumb) { + this.flag = flag; + this.binder = binder; + this.dumb = dumb; + } + + public TestObject(final Binder binder, final BoundObject obj) { + this.binder = binder; + this.obj = obj; + } + + public DumbObject getDumb() { + return dumb; + } + + @Override + public String toString() { + return flag ? "T" : "F"; + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + if (obj == null) { + fail("unexpected equals() call"); + } + return o == obj; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + if (binds != binder) { + fail("invalid binder"); + } + if (term != dumb) { + fail("invalid object"); + } + return flag; + } + + @Override + public <T> OtpErlangObject bind(final T binds) + throws OtpErlangException { + if (binds != binder) { + fail("invalid binder"); + } + return obj; + } + + } + + /* + * "always matched" object + */ + @SuppressWarnings("serial") + private static class Any extends OtpErlangObject { + + @Override + public String toString() { + return "any"; + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + return true; + } + } + + private static class Binder { + // make object pair for match() testing + TestObject makeTest(final boolean flag) { + return new TestObject(flag, this, new DumbObject()); + } + + // make object pair for bind() testing + TestObject makeTest() { + return new TestObject(this, new BoundObject()); + } + } + + private static void isNotNull(final Object o) throws Exception { + if (o == null) { + throw new Exception("not null expected"); + } + } + + private static void fail(final String string) { + System.err.println(string); + new Throwable().printStackTrace(System.err); + System.exit(1); + } + + private static void isT(final boolean b) throws Exception { + if (!b) { + throw new Exception("true expected"); + } + } + + private static void isF(final boolean b) throws Exception { + if (b) { + throw new Exception("false expected"); + } + } + + private static void equals(final OtpErlangObject a, final OtpErlangObject b) + throws Exception { + if (!a.equals(b)) { + throw new Exception(a + " != " + b); + } + } + + /* + * scalar match test - match particular test object (producing given result) + * against particular dumb object passing particular bindings object; ensure + * all participants are used as expected in match behavior, check result. + */ + private static void scalar_match_test() throws Exception { + final Binder bind = new Binder(); + + final TestObject t = bind.makeTest(true); + isT(t.match(t.getDumb(), bind)); + + final TestObject f = bind.makeTest(false); + isF(f.match(f.getDumb(), bind)); + } + + /* + * scalar bind test - ensure right object generated based on bindings + */ + private static void scalar_bind_test() throws Exception { + final Binder bind = new Binder(); + final TestObject t = bind.makeTest(); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + /* + * used by tuple_arity_match_test() + */ + private static OtpErlangObject mkTuplePattern(final int n) { + final Any a[] = new Any[n]; + for (int i = 0; i < n; i++) { + a[i] = new Any(); + } + return new OtpErlangTuple(a); + } + + /* + * used by tuple_arity_match_test() + */ + private static OtpErlangObject mkTupleObject(final int n) { + final DumbObject a[] = new DumbObject[n]; + for (int i = 0; i < n; i++) { + a[i] = new DumbObject(); + } + return new OtpErlangTuple(a); + } + + /* + * ensure only tuples of the same arity can match + */ + private static void tuple_arity_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + for (int i = m; i < n; i++) { + for (int j = m; j < n; j++) { + final OtpErlangObject p = mkTuplePattern(i); + final OtpErlangObject o = mkTupleObject(j); + if (i == j) { + isT(p.match(o, bind)); + } else { + isF(p.match(o, bind)); + } + } + } + } + + /* + * tuple match test - ensure elements of tuple are matched to corresponding + * elements of tested object and result is logical "and" over all elements. + */ + private static void tuple_match_test(final int n) throws Exception { + final Binder bind = new Binder(); + final int max = 1 << n; + final TestObject a[] = new TestObject[n]; + final DumbObject d[] = new DumbObject[n]; + for (int k = 0; k < max; k++) { + for (int m = 1, i = 0; m < max; m = m << 1, i++) { + d[i] = new DumbObject(); + a[i] = new TestObject((k & m) != 0, bind, d[i]); + } + final OtpErlangObject tpl = new OtpErlangTuple(a); + final OtpErlangObject obj = new OtpErlangTuple(d); + if (k + 1 < max) { + isF(tpl.match(obj, bind)); + } else { + isT(tpl.match(obj, bind)); + } + } + } + + /* + * tuple bind test - ensure result is a tuple where each element is a result + * of binding of corresponding pattern element using provided bindings. + */ + private static void tuple_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + } + final OtpErlangObject t = new OtpErlangTuple(a); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + private static OtpErlangObject mkListPattern(final int n, final boolean tail) + throws OtpErlangException { + final Any a[] = new Any[n]; + for (int i = 0; i < n; i++) { + a[i] = new Any(); + } + return tail ? new OtpErlangList(a, new Any()) : new OtpErlangList(a); + } + + private static OtpErlangObject mkListObject(final int n, final boolean tail) + throws OtpErlangException { + final DumbObject a[] = new DumbObject[n]; + for (int i = 0; i < n; i++) { + a[i] = new DumbObject(); + } + return tail ? new OtpErlangList(a, new DumbObject()) + : new OtpErlangList(a); + } + + /* + * ensure only lists of the same arity and same tail presence can match + */ + private static void list_arity_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + for (int i = m; i < n; i++) { + for (int j = m; j < n; j++) { + for (int k = 0; k < 2; k++) { + if (i == 0 && k == 1) { + continue; + } + for (int l = 0; l < 2; l++) { + if (j == 0 && l == 1) { + continue; + } + final OtpErlangObject p = mkListPattern(i, k == 1); + final OtpErlangObject o = mkListObject(j, l == 1); + if (i == j && k == l || k == 1 && i <= j) { + isT(p.match(o, bind)); + } else { + isF(p.match(o, bind)); + } + } + } + } + } + } + + /* + * lists match test - ensure elements of lists are matched to corresponding + * elements of tested object and result is logical "and" over all elements, + * count tails as well + */ + private static void list_match_test(final int n) throws Exception { + final Binder bind = new Binder(); + final int max = 1 << n; + final TestObject a[] = new TestObject[n]; + final DumbObject d[] = new DumbObject[n]; + final DumbObject e[] = new DumbObject[n + 1]; + for (int k = 0; k < max; k++) { + for (int m = 1, i = 0; m < max; m = m << 1, i++) { + d[i] = new DumbObject(); + e[i] = d[i]; + a[i] = new TestObject((k & m) != 0, bind, d[i]); + } + for (int i = n; i < n + 1; i++) { + e[i] = new DumbObject(); + } + final OtpErlangObject lst = new OtpErlangList(a); + final OtpErlangObject obj = new OtpErlangList(d); + final OtpErlangObject ext = new OtpErlangList(e); + final OtpErlangObject eTl = new OtpErlangList(e, new DumbObject()); + + if (n > 0) { + final DumbObject dTail = new DumbObject(); + final TestObject tTail = new TestObject(true, bind, dTail); + final TestObject fTail = new TestObject(false, bind, dTail); + final OtpErlangObject fTailLst = new OtpErlangList(a, fTail); + final OtpErlangObject tTailLst = new OtpErlangList(a, tTail); + final OtpErlangObject tailObj = new OtpErlangList(d, dTail); + + // match lists with non-matching tails is always false + isF(fTailLst.match(tailObj, bind)); + + // match list with no tail to list with tail is always false + isF(lst.match(tailObj, bind)); + + // matching lists with matching tails + if (k + 1 < max) { + isF(tTailLst.match(tailObj, bind)); + } else { + isT(tTailLst.match(tailObj, bind)); + } + + // matching shorter pattern with last tail to longer list + // with or with no extra tail; matching list pattern + // with last tail to same length list with no tail. + final Any aTail = new Any(); + final OtpErlangObject shortLst = new OtpErlangList(a, aTail); + if (k + 1 < max) { + isF(shortLst.match(obj, bind)); // same arity + isF(shortLst.match(ext, bind)); // pattern arity is less + isF(shortLst.match(eTl, bind)); // + } else { + isT(shortLst.match(obj, bind)); // same arity + isT(shortLst.match(ext, bind)); // pattern arity is less + isT(shortLst.match(eTl, bind)); // + } + } + + // matching lists with no tails + if (k + 1 < max) { + isF(lst.match(obj, bind)); + } else { + isT(lst.match(obj, bind)); + } + + // extra-length object, no tail in "pattern" + isF(lst.match(ext, bind)); + } + } + + /* + * list bind test - ensure result is a list where each element is a result + * of binding of corresponding pattern element using provided bindings. + */ + private static void list_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + } + OtpErlangObject t = new OtpErlangList(a); + OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + if (n > 0) { + // improper list case + t = new OtpErlangList(a, bind.makeTest()); + o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + } + + /* + * map match test - object may have more keys than pattern + */ + private static void map_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + + // pattern side - m elements + final OtpErlangObject k1[] = new OtpErlangObject[m]; + final TestObject a[] = new TestObject[m]; + + // object side - n elements + final OtpErlangObject k2[] = new OtpErlangObject[n]; + final DumbObject d[] = new DumbObject[n]; + + final int max = Math.max(m, n); + final int mskHi = 1 << max; + final int full = (1 << m) - 1; + for (int k = 0; k < mskHi; k++) { + for (int msk = 1, i = 0; msk < mskHi; msk = msk << 1, i++) { + if (i < n) { + k2[i] = new OtpErlangInt(i); + d[i] = new DumbObject(); + } + if (i < m) { + k1[i] = new OtpErlangInt(i); + a[i] = new TestObject((k & msk) != 0, bind, i < n ? d[i] + : new DumbObject()); + } + } + final OtpErlangObject map = new OtpErlangMap(k1, a); // m items + final OtpErlangObject obj = new OtpErlangMap(k2, d); // n items + if ((k & full) == full && m <= n) { + isT(map.match(obj, bind)); + } else { + isF(map.match(obj, bind)); + } + } + } + + /* + * map bind test - ensure result is a map where each element is a result of + * binding of corresponding pattern element using provided bindings. + */ + private static void map_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + final OtpErlangObject k[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + k[i] = new OtpErlangInt(i); + } + final OtpErlangObject t = new OtpErlangMap(k, a); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + public static void main(final String[] args) { + try { + scalar_match_test(); + System.out.println("scalar_match_test() passed"); + + scalar_bind_test(); + System.out.println("scalar_bind_test() passed"); + + for (int m = 0; m < 16; m++) { + for (int n = 0; n < 16; n++) { + tuple_arity_match_test(m, n); + } + } + System.out.println("tuple_arity_match_test() passed"); + + for (int n = 0; n < 16; n++) { + tuple_match_test(n); + } + System.out.println("tuple_match_test() passed"); + + for (int n = 0; n < 16; n++) { + tuple_bind_test(n); + } + System.out.println("tuple_bind_test() passed"); + + for (int m = 0; m < 16; m++) { + for (int n = 0; n < 16; n++) { + list_arity_match_test(m, n); + } + } + System.out.println("list_arity_match_test() passed"); + + for (int n = 0; n < 16; n++) { + list_match_test(n); + } + System.out.println("list_match_test() passed"); + + for (int n = 0; n < 16; n++) { + list_bind_test(n); + } + System.out.println("list_bind_test() passed"); + + for (int m = 0; m < 12; m++) { + for (int n = 0; n < 12; n++) { + map_match_test(m, n); + } + } + System.out.println("map_match_test() passed"); + + for (int n = 0; n < 16; n++) { + map_bind_test(n); + } + System.out.println("map_bind_test() passed"); + + } catch (final Exception e) { + e.printStackTrace(); + System.exit(1); + } + + System.out.println("ok"); + } +} diff --git a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src index eca043913e..a4a69000c6 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src +++ b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src @@ -49,7 +49,8 @@ JAVA_FILES = \ MboxLinkUnlink.java \ NodeStatusHandler.java \ Maps.java \ - FunEquals.java + FunEquals.java \ + CoreMatchBind.java CLASS_FILES = $(JAVA_FILES:.java=.class) diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 0eda558ed5..d73d1ff281 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -339,7 +339,7 @@ do_start(Flags) -> ok end, %% Quietly load native code for all modules loaded so far - catch load_native_code_for_all_loaded(), + load_native_code_for_all_loaded(), Ok2; Other -> Other @@ -550,18 +550,42 @@ has_ext(Ext, Extlen, File) -> _ -> false end. +%%% +%%% Silently load native code for all modules loaded so far. +%%% + -spec load_native_code_for_all_loaded() -> ok. load_native_code_for_all_loaded() -> Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - lists:foreach(fun({Module, BeamFilename}) -> - case code:is_module_native(Module) of - false -> - case beam_lib:chunks(BeamFilename, [ChunkName]) of - {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> - load_native_partial(Module, Bin); - {error, beam_lib, _} -> ok - end; - true -> ok - end - end, all_loaded()). + try hipe_unified_loader:chunk_name(Architecture) of + ChunkTag -> + Loaded = all_loaded(), + spawn(fun() -> load_all_native(Loaded, ChunkTag) end) + catch + _:_ -> + ok + end, + ok. + +load_all_native(Loaded, ChunkTag) -> + catch load_all_native_1(Loaded, ChunkTag). + +load_all_native_1([{_,preloaded}|T], ChunkTag) -> + load_all_native_1(T, ChunkTag); +load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) -> + case code:is_module_native(Mod) of + false -> + %% prim_file is faster than file and the file server may + %% not be started yet. + {ok,Beam} = prim_file:read_file(BeamFilename), + case code:get_chunk(Beam, ChunkTag) of + undefined -> + ok; + NativeCode when is_binary(NativeCode) -> + load_native_partial(Mod, NativeCode) + end; + true -> ok + end, + load_all_native_1(T, ChunkTag); +load_all_native_1([], _) -> + ok. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 17bee06b5e..8f81fcf825 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -20,7 +20,7 @@ %% Low-level debugging support. EXPERIMENTAL! --export([size/1,df/1,df/2,df/3]). +-export([size/1,df/1,df/2,df/3,ic/1]). %% This module contains the following *experimental* BIFs: %% disassemble/1 @@ -114,6 +114,19 @@ get_internal_state(_) -> instructions() -> erlang:nif_error(undef). +-spec ic(F) -> Result when + F :: function(), + Result :: term(). + +ic(F) when is_function(F) -> + Is0 = erlang:system_info(instruction_counts), + R = F(), + Is1 = erlang:system_info(instruction_counts), + Is = lists:keysort(2,[{I,C1 - C0}||{{I,C1},{I,C0}} <- lists:zip(Is1,Is0)]), + _ = [io:format("~12w ~w~n", [C,I])||{I,C}<-Is], + io:format("Total: ~w~n",[lists:sum([C||{_I,C}<-Is])]), + R. + -spec lock_counters(info) -> term(); (clear) -> ok; ({copy_save, boolean()}) -> boolean(); 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/kernel.erl b/lib/kernel/src/kernel.erl index ecdb32424a..cc5683ba06 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -117,7 +117,7 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [File, Code, StdError, User, + [Code, File, StdError, User, Config, SafeSupervisor]}}; _ -> Rpc = {rex, {rpc, start_link, []}, @@ -139,8 +139,8 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, Code, + [Code, Rpc, Global, InetDb | DistAC] ++ + [NetSup, Glo_grp, File, StdError, User, Config, SafeSupervisor] ++ Timer}} end; init(safe) -> diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index e6ce85c379..380c685869 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -133,6 +133,7 @@ server1(Iport, Oport, Shell) -> flatten(io_lib:format("~ts\n", [erlang:system_info(system_version)]))}, Iport, Oport), + %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr, queue:new()). @@ -315,6 +316,9 @@ handle_escape(Iport, Oport, User, Gr, IOQueue) -> _ -> % {ok,jcl} | undefined io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), + %% init edlin used by switch command and have it copy the + %% text buffer from current group process + edlin:init(gr_cur_pid(Gr)), server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) end. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index afedc17e57..549c65d034 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -1396,8 +1396,9 @@ on_load_binary(_) -> {tuple,6,[{atom,6,Mod},{call,6,{atom,6,self},[]}]}}, {'receive',7,[{clause,8,[{atom,8,go}],[],[{atom,8,ok}]}]}]}]}, {function,11,ok,0,[{clause,11,[],[],[{atom,11,true}]}]}], - {ok,Mod,Bin} = compile:forms(Forms, [report]), - [io:put_chars(erl_pp:form(F)) || F <- Forms], + Forms1 = erl_parse:new_anno(Forms), + {ok,Mod,Bin} = compile:forms(Forms1, [report]), + [io:put_chars(erl_pp:form(F)) || F <- Forms1], {Pid1,Ref1} = spawn_monitor(fun() -> code:load_binary(Mod, File, Bin), diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 35d3b75b34..43224cf554 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -562,13 +562,15 @@ suicide_by_heart() -> generate(Module, Attributes, FunStrings) -> FunForms = function_forms(FunStrings), Forms = [ - {attribute,1,module,Module}, - {attribute,2,export,[FA || {FA,_} <- FunForms]} - ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++ + {attribute,a(1),module,Module}, + {attribute,a(2),export,[FA || {FA,_} <- FunForms]} + ] ++ [{attribute, a(3), A, V}|| {A, V} <- Attributes] ++ [ Function || {_, Function} <- FunForms], {ok, Module, Bin} = compile:forms(Forms), Bin. +a(L) -> + erl_anno:new(L). function_forms([]) -> []; function_forms([S|Ss]) -> 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 30bd90347d..5dda63982f 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.0","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/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index 855bff5fdc..b9bba9a7c2 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -124,21 +124,10 @@ yecc_end(Line) -> {'$end', Line}. yecctoken_end_location(Token) -> - try - {text, Str} = erl_scan:token_info(Token, text), - {line, Line} = erl_scan:token_info(Token, line), - Parts = re:split(Str, "\n"), - Dline = length(Parts) - 1, - Yline = Line + Dline, - case erl_scan:token_info(Token, column) of - {column, Column} -> - Col = byte_size(lists:last(Parts)), - {Yline, Col + if Dline =:= 0 -> Column; true -> 1 end}; - undefined -> - Yline - end - catch _:_ -> - yecctoken_location(Token) + try erl_anno:end_location(element(2, Token)) of + undefined -> yecctoken_location(Token); + Loc -> Loc + catch _:_ -> yecctoken_location(Token) end. -compile({nowarn_unused_function, yeccerror/1}). @@ -149,15 +138,15 @@ yeccerror(Token) -> -compile({nowarn_unused_function, yecctoken_to_string/1}). yecctoken_to_string(Token) -> - case catch erl_scan:token_info(Token, text) of - {text, Txt} -> Txt; - _ -> yecctoken2string(Token) + try erl_scan:text(Token) of + undefined -> yecctoken2string(Token); + Txt -> Txt + catch _:_ -> yecctoken2string(Token) end. yecctoken_location(Token) -> - case catch erl_scan:token_info(Token, location) of - {location, Loc} -> Loc; - _ -> element(2, Token) + try erl_scan:location(Token) + catch _:_ -> element(2, Token) end. -compile({nowarn_unused_function, yecctoken2string/1}). diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 03f864ff03..15d42a4d9c 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -1545,7 +1545,7 @@ out_action_code(File, XrlFile, {_A,Code,_Vars,Name,Args,ArgsChars}) -> %% Should set the file to the .erl file, but instead assumes that %% ?LEEXINC is syntactically correct. io:fwrite(File, "\n-compile({inline,~w/~w}).\n", [Name, length(Args)]), - {line, L} = erl_scan:token_info(hd(Code), line), + L = erl_scan:line(hd(Code)), output_file_directive(File, XrlFile, L-2), io:fwrite(File, "~s(~s) ->~n", [Name, ArgsChars]), io:fwrite(File, " ~s\n", [pp_tokens(Code, L)]). @@ -1557,7 +1557,7 @@ pp_tokens(Tokens, Line0) -> pp_tokens(Tokens, Line0, none). pp_tokens([], _Line0, _) -> []; pp_tokens([T | Ts], Line0, Prev) -> - {line, Line} = erl_scan:token_info(T, line), + Line = erl_scan:line(T), [pp_sep(Line, Line0, Prev, T), pp_symbol(T) | pp_tokens(Ts, Line, T)]. pp_symbol({var,_,Var}) -> atom_to_list(Var); diff --git a/lib/parsetools/src/yeccgramm.yrl b/lib/parsetools/src/yeccgramm.yrl index 562a9a7458..d76ebfc569 100644 --- a/lib/parsetools/src/yeccgramm.yrl +++ b/lib/parsetools/src/yeccgramm.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,8 +38,8 @@ rule -> head '->' symbols attached_code dot: {rule, ['$1' | '$3'], '$4'}. head -> symbol : '$1'. symbols -> symbol : ['$1']. symbols -> symbol symbols : ['$1' | '$2']. -strings -> string : ['$1']. -strings -> string strings : ['$1' | '$2']. +strings -> string : [string('$1')]. +strings -> string strings : [string('$1') | '$2']. attached_code -> ':' tokens : {erlang_code, '$2'}. attached_code -> '$empty' : {erlang_code, [{atom, 0, '$undefined'}]}. tokens -> token : ['$1']. @@ -48,12 +48,12 @@ symbol -> var : symbol('$1'). symbol -> atom : symbol('$1'). symbol -> integer : symbol('$1'). symbol -> reserved_word : symbol('$1'). -token -> var : '$1'. -token -> atom : '$1'. -token -> float : '$1'. -token -> integer : '$1'. -token -> string : '$1'. -token -> char : '$1'. +token -> var : token('$1'). +token -> atom : token('$1'). +token -> float : token('$1'). +token -> integer : token('$1'). +token -> string : token('$1'). +token -> char : token('$1'). token -> reserved_symbol : {value_of('$1'), line_of('$1')}. token -> reserved_word : {value_of('$1'), line_of('$1')}. token -> '->' : {'->', line_of('$1')}. % Have to be treated in this @@ -67,8 +67,14 @@ Erlang code. symbol(Symbol) -> #symbol{line = line_of(Symbol), name = value_of(Symbol)}. +token(Token) -> + setelement(2, Token, line_of(Token)). + +string(Token) -> + setelement(2, Token, line_of(Token)). + value_of(Token) -> element(3, Token). line_of(Token) -> - element(2, Token). + erl_anno:line(element(2, Token)). diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl index 54f9ba5a58..fa0a1c4e2a 100644 --- a/lib/parsetools/src/yeccparser.erl +++ b/lib/parsetools/src/yeccparser.erl @@ -7,17 +7,23 @@ symbol(Symbol) -> #symbol{line = line_of(Symbol), name = value_of(Symbol)}. +token(Token) -> + setelement(2, Token, line_of(Token)). + +string(Token) -> + setelement(2, Token, line_of(Token)). + value_of(Token) -> element(3, Token). line_of(Token) -> - element(2, Token). + erl_anno:line(element(2, Token)). --file("/clearcase/otp/erts/lib/parsetools/include/yeccpre.hrl", 0). +-file("lib/parsetools/include/yeccpre.hrl", 0). %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -44,10 +50,11 @@ parse(Tokens) -> -spec parse_and_scan({function() | {atom(), atom()}, [_]} | {atom(), atom(), [_]}) -> yecc_ret(). -parse_and_scan({F, A}) -> % Fun or {M, F} +parse_and_scan({F, A}) -> yeccpars0([], {{F, A}, no_line}, 0, [], []); parse_and_scan({M, F, A}) -> - yeccpars0([], {{{M, F}, A}, no_line}, 0, [], []). + Arity = length(A), + yeccpars0([], {{fun M:F/Arity, A}, no_line}, 0, [], []). -spec format_error(any()) -> [char() | list()]. format_error(Message) -> @@ -140,13 +147,13 @@ yecc_end(Line) -> yecctoken_end_location(Token) -> try - {text, Str} = erl_scan:token_info(Token, text), - {line, Line} = erl_scan:token_info(Token, line), + Str = erl_scan:text(Token), + Line = erl_scan:line(Token), Parts = re:split(Str, "\n"), Dline = length(Parts) - 1, Yline = Line + Dline, - case erl_scan:token_info(Token, column) of - {column, Column} -> + case erl_scan:column(Token) of + Column when is_integer(Column) -> Col = byte_size(lists:last(Parts)), {Yline, Col + if Dline =:= 0 -> Column; true -> 1 end}; undefined -> @@ -156,23 +163,26 @@ yecctoken_end_location(Token) -> yecctoken_location(Token) end. +-compile({nowarn_unused_function, yeccerror/1}). yeccerror(Token) -> Text = yecctoken_to_string(Token), Location = yecctoken_location(Token), {error, {Location, ?MODULE, ["syntax error before: ", Text]}}. +-compile({nowarn_unused_function, yecctoken_to_string/1}). yecctoken_to_string(Token) -> - case catch erl_scan:token_info(Token, text) of - {text, Txt} -> Txt; + case catch erl_scan:text(Token) of + Txt when is_list(Txt) -> Txt; _ -> yecctoken2string(Token) end. yecctoken_location(Token) -> - case catch erl_scan:token_info(Token, location) of - {location, Loc} -> Loc; + case catch erl_scan:location(Token) of + Loc when Loc =/= undefined -> Loc; _ -> element(2, Token) end. +-compile({nowarn_unused_function, yecctoken2string/1}). yecctoken2string({atom, _, A}) -> io_lib:write(A); yecctoken2string({integer,_,N}) -> io_lib:write(N); yecctoken2string({float,_,F}) -> io_lib:write(F); @@ -180,7 +190,7 @@ yecctoken2string({char,_,C}) -> io_lib:write_char(C); yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); yecctoken2string({string,_,S}) -> io_lib:write_string(S); yecctoken2string({reserved_symbol, _, A}) -> io_lib:write(A); -yecctoken2string({_Cat, _, Val}) -> io_lib:write(Val); +yecctoken2string({_Cat, _, Val}) -> io_lib:format("~p",[Val]); yecctoken2string({dot, _}) -> "'.'"; yecctoken2string({'$end', _}) -> []; @@ -193,7 +203,7 @@ yecctoken2string(Other) -> --file("yeccparser.erl", 196). +-file("yeccgramm.erl", 207). yeccpars2(0=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2_0(S, Cat, Ss, Stack, T, Ts, Tzr); @@ -268,7 +278,7 @@ yeccpars2(34=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2(35=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2_35(S, Cat, Ss, Stack, T, Ts, Tzr); yeccpars2(Other, _, _, _, _, _, _) -> - erlang:error({yecc_bug,"1.3",{missing_state_in_action_table, Other}}). + erlang:error({yecc_bug,"1.4",{missing_state_in_action_table, Other}}). yeccpars2_0(S, atom, Ss, Stack, T, Ts, Tzr) -> yeccpars1(S, 6, Ss, Stack, T, Ts, Tzr); @@ -417,16 +427,20 @@ yeccpars2_19(_S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_20(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_20_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_21(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_21_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_22(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_22_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_23(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_23_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_24(_S, Cat, Ss, Stack, T, Ts, Tzr) -> NewStack = yeccpars2_24_(Stack), @@ -437,10 +451,12 @@ yeccpars2_25(_S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_26(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_26_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_27(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_27_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_28(_S, Cat, Ss, Stack, T, Ts, Tzr) -> [_|Nss] = Ss, @@ -616,6 +632,38 @@ yeccpars2_19_(__Stack0) -> { ':' , line_of ( __1 ) } end | __Stack]. +-compile({inline,yeccpars2_20_/1}). +-file("yeccgramm.yrl", 48). +yeccpars2_20_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_21_/1}). +-file("yeccgramm.yrl", 52). +yeccpars2_21_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_22_/1}). +-file("yeccgramm.yrl", 49). +yeccpars2_22_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_23_/1}). +-file("yeccgramm.yrl", 50). +yeccpars2_23_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + -compile({inline,yeccpars2_24_/1}). -file("yeccgramm.yrl", 53). yeccpars2_24_(__Stack0) -> @@ -632,6 +680,22 @@ yeccpars2_25_(__Stack0) -> { value_of ( __1 ) , line_of ( __1 ) } end | __Stack]. +-compile({inline,yeccpars2_26_/1}). +-file("yeccgramm.yrl", 51). +yeccpars2_26_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_27_/1}). +-file("yeccgramm.yrl", 47). +yeccpars2_27_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + -compile({inline,yeccpars2_28_/1}). -file("yeccgramm.yrl", 42). yeccpars2_28_(__Stack0) -> @@ -653,7 +717,7 @@ yeccpars2_29_(__Stack0) -> yeccpars2_32_(__Stack0) -> [__1 | __Stack] = __Stack0, [begin - [ __1 ] + [ string ( __1 ) ] end | __Stack]. -compile({inline,yeccpars2_33_/1}). @@ -661,7 +725,7 @@ yeccpars2_32_(__Stack0) -> yeccpars2_33_(__Stack0) -> [__2,__1 | __Stack] = __Stack0, [begin - [ __1 | __2 ] + [ string ( __1 ) | __2 ] end | __Stack]. -compile({inline,yeccpars2_34_/1}). @@ -681,4 +745,4 @@ yeccpars2_35_(__Stack0) -> end | __Stack]. --file("yeccgramm.yrl", 75). +-file("yeccgramm.yrl", 82). diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index c18dc15e37..b8d658e5c2 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -1521,7 +1521,9 @@ otp_7945(doc) -> "OTP-7945. A bug introduced in R13A."; otp_7945(suite) -> []; otp_7945(Config) when is_list(Config) -> - ?line {error,_} = erl_parse:parse([{atom,3,foo},{'.',2,9,9}]), + A2 = erl_anno:new(2), + A3 = erl_anno:new(3), + {error,_} = erl_parse:parse([{atom,3,foo},{'.',A2,9,9}]), ok. otp_8483(doc) -> @@ -1786,7 +1788,8 @@ otp_7969(Config) when is_list(Config) -> ?line {ok, Ts11, _}=R1 = erl_scan:string("f() -> a."), ?line F1 = fun() -> {ok,Ts11 ++ [{'$end',2}],2} end, - ?line{ok,{function,1,f,0,[{clause,1,[],[],[{atom,1,a}]}]}} = + A1 = erl_anno:new(1), + {ok,{function,A1,f,0,[{clause,A1,[],[],[{atom,A1,a}]}]}} = erl_parse:parse_and_scan({F1, []}), ?line F2 = fun() -> erl_scan:string("f() -> ,") end, ?line {error,{1,erl_parse,_}} = erl_parse:parse_and_scan({F2, []}), @@ -1797,7 +1800,7 @@ otp_7969(Config) when is_list(Config) -> put(foo,bar), R1 end end, - ?line {ok,{function,1,f,0,[{clause,1,[],[],[{atom,1,a}]}]}} = + {ok,{function,A1,f,0,[{clause,A1,[],[],[{atom,A1,a}]}]}} = erl_parse:parse_and_scan({F3,[]}), F4 = fun() -> {error, {1, ?MODULE, bad}, 2} end, ?line {error, {1,?MODULE,bad}} = erl_parse:parse_and_scan({F4, []}), @@ -1813,7 +1816,8 @@ otp_8919(doc) -> "OTP-8919. Improve formating of Yecc error messages."; otp_8919(suite) -> []; otp_8919(Config) when is_list(Config) -> - {error,{1,Mod,Mess}} = erl_parse:parse([{cat,1,"hello"}]), + A1 = erl_anno:new(1), + {error,{1,Mod,Mess}} = erl_parse:parse([{cat,A1,"hello"}]), "syntax error before: \"hello\"" = lists:flatten(Mod:format_error(Mess)), ok. diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index 17fb67e95c..2adc13a5cf 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 \ + records.xml \ using_public_key.xml \ notes.xml 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..d3cc9303bd 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="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..6d220c9b69 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,151 @@ <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><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> - - <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> - - <p><code>rsa_private_key() = #'RSAPrivateKey'{}</code></p> - - <p><code>dsa_public_key() = {integer(), #'Dss-Parms'{}}</code></p> + <p>The following data types are used in the functions for <c>public_key</c>:</p> - <p><code>dsa_private_key() = #'DSAPrivateKey'{}</code></p> - - <p><code>ec_public_key() = {#'ECPoint'{}, #'EcpkParameters'{} | - {namedCurve, oid()}}</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> + + <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> + + <tag><c>rsa_public_key()</c></tag> + <item><p>= <c>#'RSAPublicKey'{}</c></p></item> + + <tag><c>rsa_private_key()</c></tag> + <item><p>= <c>#'RSAPrivateKey'{}</c></p></item> + + <tag><c>dsa_public_key()</c></tag> + <item><p>= <c>{integer(), #'Dss-Parms'{}}</c></p></item> + + <tag><c>dsa_private_key()</c></tag> + <item><p>= <c>#'DSAPrivateKey'{}</c></p></item> + + <tag><c>ec_public_key()</c></tag> + <item><p>= <c>{#'ECPoint'{}, #'EcpkParameters'{} | {namedCurve, oid()}}</c></p></item> + + <tag><c>ec_private_key()</c></tag> + <item><p>= <c>#'ECPrivateKey'{}</c></p></item> + + <tag><c>public_crypt_options()</c></tag> + <item><p>= <c>[{rsa_pad, rsa_padding()}]</c></p></item> + + <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> + + <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> + + <tag><c>rsa_digest_type()</c></tag> + <item><p>= <c>'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item> + + <tag><c>dss_digest_type()</c></tag> + <item><p>= <c>'sha'</c></p></item> + + <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>ec_private_key() = #'ECPrivateKey'{}</code></p> - - <p><code>public_crypt_options() = [{rsa_pad, rsa_padding()}].</code></p> - - <p><code>rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | - 'rsa_no_padding'</code></p> - - <p><code>digest_type() - Union of below digest types</code></p> - - <p><code>rsa_digest_type() = 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | - 'sha512'</code></p> - - <p><code>dss_digest_type() = 'sha'</code></p> - - <p><code>ecdsa_digest_type() = 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'</code></p> - - <p><code>crl_reason() = unspecified | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | privilegeWithdrawn | aACompromise</code></p> - - <p><code>issuer_name() = {rdnSequence,[#'AttributeTypeAndValue'{}]} </code> </p> - - <p><code>ssh_file() = openssh_public_key | rfc4716_public_key | known_hosts | - auth_keys</code></p> <!-- <p><code>policy_tree() = [Root, Children]</code></p> --> @@ -138,12 +195,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 +208,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 +223,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 +251,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 +412,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 +468,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 +512,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 +535,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 +600,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 +695,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 +779,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 +797,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 deleted file mode 100644 index a7dfc41449..0000000000 --- a/lib/public_key/doc/src/public_key_records.xml +++ /dev/null @@ -1,153 +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>Public key records</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date>2008-02-06</date> - <rev>A</rev> - <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>Use the following include directive to get access to the - 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> - - <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> - - <section> - <title>RSA as defined by the PKCS-1 standard and <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 3447 </url></title> - - <code> -#'RSAPublicKey'{ - modulus, % integer() - publicExponent % integer() - }. - -#'RSAPrivateKey'{ - version, % two-prime | multi - modulus, % integer() - publicExponent, % integer() - privateExponent, % integer() - prime1, % integer() - prime2, % integer() - exponent1, % integer() - exponent2, % integer() - coefficient, % integer() - otherPrimeInfos % [#OtherPrimeInfo{}] | asn1_NOVALUE - }. - -#'OtherPrimeInfo'{ - prime, % integer() - exponent, % integer() - coefficient % integer() - }. - </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> - - <code> -#'DSAPrivateKey',{ - version, % integer() - p, % integer() - q, % integer() - g, % integer() - y, % integer() - x % integer() - }. - -#'Dss-Parms',{ - p, % integer() - q, % integer() - g % integer() - }. - </code> - </section> - - <section> - <title>ECC (Elliptic Curve) <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 5480 </url> - </title> - - <code> -#'ECPrivateKey'{ - version, % integer() - privateKey, % binary() - parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | - {'EcpkParameters', {namedCurve, oid()}} | - {'EcpkParameters', 'NULL'} % Inherited by CA - publicKey % bitstring() - }. - -#'ECParameters'{ - version, % integer() - fieldID, % #'FieldID'{} - curve, % #'Curve'{} - base, % binary() - order, % integer() - cofactor % integer() - }. - -#'Curve'{ - a, % binary() - b, % binary() - seed % bitstring() - optional - - }. - -#'FieldID'{ - fieldType, % oid() - parameters % Depending on fieldType - }. - -#'ECPoint'{ - point % binary() - the public key - }. - - </code> - </section> - -</chapter> diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/records.xml index 857a39bf40..9536167839 100644 --- a/lib/public_key/doc/src/cert_records.xml +++ b/lib/public_key/doc/src/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>Certificate records</title> + <title>Public-Key Records</title> <prepared>Ingela Anderton Andin</prepared> <responsible></responsible> <docno></docno> @@ -31,69 +31,181 @@ <checked></checked> <date>2008-02-06</date> <rev>A</rev> - <file>cert_records.xml</file> + <file>public_key_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>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 (OIDs) 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> - <p>The used ASN1 specifications are available <c>asn1</c> subdirectory - of the application <c>public_key</c>. - </p> + <section> + <title>Data Types</title> - <section> - <title>Common Data Types</title> + <p>Common non-standard Erlang + 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> - <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> + <tag><c>uct_time()</c></tag> + <item><p>= <c>{utcTime, "YYMMDDHHMMSSZ"}</c></p></item> - <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> + <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</title> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc3447.txt"> + Rivest-Shamir-Adleman cryptosystem (RSA)</url> keys follows:</p> - <p><c> - special_string() = - {teletexString, string()} | {printableString, string()} | - {universalString, string()} | {utf8String, binary()} | - {bmpString, string()} - </c></p> + <code> +#'RSAPublicKey'{ + modulus, % integer() + publicExponent % integer() + }. + +#'RSAPrivateKey'{ + version, % two-prime | multi + modulus, % integer() + publicExponent, % integer() + privateExponent, % integer() + prime1, % integer() + prime2, % integer() + exponent1, % integer() + exponent2, % integer() + coefficient, % integer() + otherPrimeInfos % [#OtherPrimeInfo{}] | asn1_NOVALUE + }. + +#'OtherPrimeInfo'{ + prime, % integer() + exponent, % integer() + coefficient % integer() + }. </code> + + </section> + + <section> + <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() + p, % integer() + q, % integer() + g, % integer() + y, % integer() + x % integer() + }. + +#'Dss-Parms',{ + p, % integer() + q, % integer() + g % integer() + }. </code> + + </section> + + <section> + <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> - <p><c> - dist_reason() = unused | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | privilegeWithdrawn | - aACompromise - </c></p> + <code> +#'ECPrivateKey'{ + version, % integer() + privateKey, % binary() + parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | + {'EcpkParameters', {namedCurve, oid()}} | + {'EcpkParameters', 'NULL'} % Inherited by CA + publicKey % bitstring() + }. + +#'ECParameters'{ + version, % integer() + fieldID, % #'FieldID'{} + curve, % #'Curve'{} + base, % binary() + order, % integer() + cofactor % integer() + }. + +#'Curve'{ + a, % binary() + b, % binary() + seed % bitstring() - optional + + }. + +#'FieldID'{ + fieldType, % oid() + parameters % Depending on fieldType + }. + +#'ECPoint'{ + point % binary() - the public key + }.</code> </section> - <section> - <title> PKIX Certificates</title> + <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'{} @@ -117,9 +229,10 @@ semantics, please see <url #'AlgorithmIdentifier'{ algorithm, % oid() parameters % der_encoded() - }. -</code> + }.</code> +<p>Erlang alternate representation of PKIX certificate, also referred to as <c>otp</c> type</p> + <code> #'OTPCertificate'{ tbsCertificate, % #'OTPTBSCertificate'{} @@ -143,20 +256,20 @@ semantics, please see <url #'SignatureAlgorithm'{ algorithm, % id_signature_algorithm() parameters % asn1_novalue | #'Dss-Parms'{} - }. -</code> + }.</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> +<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">OID name</cell> + <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 alt oid to above)</cell> + <cell align="left" valign="middle">id-dsaWithSHA1 (ISO or OID to above)</cell> </row> <row> <cell align="left" valign="middle">md2WithRSAEncryption</cell> @@ -168,7 +281,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <cell align="left" valign="middle">sha1WithRSAEncryption</cell> </row> <row> - <cell align="left" valign="middle">sha-1WithRSAEncryption (ISO alt oid to above)</cell> + <cell align="left" valign="middle">sha-1WithRSAEncryption (ISO or OID to above)</cell> </row> <row> <cell align="left" valign="middle">sha224WithRSAEncryption</cell> @@ -182,21 +295,24 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <row> <cell align="left" valign="middle">ecdsa-with-SHA1</cell> </row> - <tcaption>Signature algorithm oids </tcaption> + <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> + }.</code> -<p><c>id_attributes() </c></p> +<p>The attribute OID name atoms and their corresponding value types +are as follows:</p> <table> <row> - <cell align="left" valign="middle">OID name</cell> - <cell align="left" valign="middle">Value type</cell> + <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> @@ -254,9 +370,12 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <cell align="left" valign="middle">id-at-pseudonym</cell> <cell align="left" valign="middle">special_string()</cell> </row> - <tcaption>Attribute oids </tcaption> + <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() @@ -271,13 +390,12 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'SubjectPublicKeyInfoAlgorithm'{ algorithm, % id_public_key_algorithm() parameters % public_key_params() - }. -</code> + }.</code> -<p><c> id_public_key_algorithm() </c></p> +<p>The public-key algorithm OID name atoms are as follows:</p> <table> <row> - <cell align="left" valign="middle">OID name</cell> + <cell align="left" valign="middle"><em>OID Name</em></cell> </row> <row> <cell align="left" valign="middle">rsaEncryption</cell> @@ -294,7 +412,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <row> <cell align="left" valign="middle">id-ecPublicKey</cell> </row> - <tcaption>Public key algorithm oids </tcaption> + <tcaption>Public-Key Algorithm OIDs</tcaption> </table> <code> @@ -302,8 +420,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> extnID, % id_extensions() | oid() critical, % boolean() extnValue % der_encoded() - }. -</code> + }.</code> <p><c>id_extensions()</c> <seealso marker="#StdCertExt">Standard Certificate Extensions</seealso>, @@ -316,12 +433,15 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <section> <marker id="StdCertExt"></marker> - <title>Standard certificate extensions</title> - + <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">OID name</cell> - <cell align="left" valign="middle">Value type</cell> + <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> @@ -333,7 +453,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> </row> <row> <cell align="left" valign="middle">id-ce-keyUsage</cell> - <cell align="left" valign="middle"> [key_usage()]</cell> + <cell align="left" valign="middle">[key_usage()]</cell> </row> <row> <cell align="left" valign="middle">id-ce-privateKeyUsagePeriod</cell> @@ -400,17 +520,26 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <tcaption>Standard Certificate Extensions</tcaption> </table> - <p><c> - key_usage() = digitalSignature | nonRepudiation | keyEncipherment| - dataEncipherment | keyAgreement | keyCertSign | cRLSign | encipherOnly | - decipherOnly - </c></p> + <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><c> id_key_purpose()</c></p> + <p>And for <c>id_key_purpose()</c>:</p> <table> <row> - <cell align="left" valign="middle">OID name</cell> + <cell align="left" valign="middle"><em>OID Name</em></cell> </row> <row> <cell align="left" valign="middle">id-kp-serverAuth</cell> @@ -430,7 +559,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <row> <cell align="left" valign="middle">id-kp-OCSPSigning</cell> </row> - <tcaption>Key purpose oids </tcaption> + <tcaption>Key Purpose OIDs</tcaption> </table> <code> @@ -501,8 +630,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> [#AttributeTypeAndValue{}]} reasons, % [dist_reason()] cRLIssuer % [general_name()] - }). -</code> + }).</code> </section> @@ -510,10 +638,13 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <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">OID name</cell> - <cell align="left" valign="middle">Value type</cell> + <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> @@ -530,13 +661,15 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'AccessDescription'{ accessMethod, % oid() accessLocation % general_name() - }). -</code> + }).</code> </section> <section> - <title> CRL and CRL Extensions Profile</title> + <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'{ @@ -559,17 +692,19 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> userCertificate, % integer() revocationDate, % timer() crlEntryExtensions % [#'Extension'{}] - }). - </code> + }).</code> <section> <marker id="CRLCertExt"></marker> - <title>CRL Extensions </title> + <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">OID name</cell> - <cell align="left" valign="middle">Value type</cell> + <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> @@ -599,6 +734,9 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> <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, @@ -608,18 +746,19 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> onlySomeReasons, % [dist_reason()] indirectCRL, % boolean() onlyContainsAttributeCerts % boolean() - }). - </code> + }).</code> </section> <section> <marker id="CRLEntryExt"></marker> - <title> CRL Entry Extensions </title> + <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">OID name</cell> - <cell align="left" valign="middle">Value type</cell> + <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> @@ -639,17 +778,31 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> </row> <tcaption>CRL Entry Extensions</tcaption> </table> - <p><c> - crl_reason() = unspecified | keyCompromise | cACompromise | - affiliationChanged | superseded | cessationOfOperation | - certificateHold | removeFromCRL | privilegeWithdrawn | - aACompromise - </c></p> + + + <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'{}, @@ -666,7 +819,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'CertificationRequestInfo_subjectPKInfo'{ algorithm #'CertificationRequestInfo_subjectPKInfo_algorithm'{} - subjectPublicKey bitstring() + subjectPublicKey bitstring() } #'CertificationRequestInfo_subjectPKInfo_algorithm'{ @@ -682,9 +835,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'AttributePKCS-10'{ type = oid(), values = [der_encoded()] -} - </code> +} </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/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index fd307ef824..52022f59ff 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,7 +33,40 @@ </header> - <section> + <section><title>SNMP 5.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug in the SNMP Agent has been corrected; when opening + a port using the command line argument -snmpa_fd the Port + should be 0 when calling gen_udp:open.</p> + <p> + A bug in the SNMP manager has been corrected; it should + not look at the -snmp_fd command line argument, but + instead at -snmpm_fd.</p> + <p> + Own Id: OTP-12669 Aux Id: seq12841 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved cryptocraphic capability.</p> + <p> + Own Id: OTP-12452</p> + </item> + </list> + </section> + +</section> + +<section> <title>SNMP Development Toolkit 5.1.1</title> <p>Version 5.1.1 supports code replacement in runtime from/to version 5.1. </p> diff --git a/lib/snmp/src/agent/snmp_shadow_table.erl b/lib/snmp/src/agent/snmp_shadow_table.erl index 34543d542b..c4704e201b 100644 --- a/lib/snmp/src/agent/snmp_shadow_table.erl +++ b/lib/snmp/src/agent/snmp_shadow_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -76,7 +76,7 @@ delete_time_stamp_table() -> end. update(Name, UpdateFunc, Interval) -> - CurrentTime = get_time(), + CurrentTime = snmp_misc:now(ms), case mnesia:dirty_read({time_stamp, Name}) of [#time_stamp{data = Expire}] when CurrentTime =< Expire -> ok; _ -> @@ -117,9 +117,6 @@ table_func(Op, RowIndex, Cols, update(Name, UpdateFunc, Interval), snmp_generic:table_func(Op, RowIndex, Cols, {Name, mnesia}). -get_time() -> - {M,S,U} = erlang:now(), - 1000000000 * M + 1000 * S + (U div 1000). %%----------------------------------------------------------------- %% Urrk. @@ -183,5 +180,3 @@ delete_table(Tab) -> error_msg(F, A) -> ?snmpa_error(F, A). - - diff --git a/lib/snmp/src/agent/snmp_standard_mib.erl b/lib/snmp/src/agent/snmp_standard_mib.erl index aace3fd413..53f733ae4e 100644 --- a/lib/snmp/src/agent/snmp_standard_mib.erl +++ b/lib/snmp/src/agent/snmp_standard_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -546,8 +546,9 @@ dummy(_Op) -> ok. %%----------------------------------------------------------------- snmp_set_serial_no(new) -> snmp_generic:variable_func(new, {snmpSetSerialNo, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {snmpSetSerialNo, volatile}); diff --git a/lib/snmp/src/agent/snmp_target_mib.erl b/lib/snmp/src/agent/snmp_target_mib.erl index ef9503cda8..f66c54849f 100644 --- a/lib/snmp/src/agent/snmp_target_mib.erl +++ b/lib/snmp/src/agent/snmp_target_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -346,13 +346,6 @@ check_target_params(X) -> error({invalid_target_params, X}). - -%% maybe_create_table(Name) -> -%% case snmpa_local_db:table_exists(db(Name)) of -%% true -> ok; -%% _ -> snmpa_local_db:table_create(db(Name)) -%% end. - init_tabs(Addrs, Params) -> ?vdebug("create target address table",[]), AddrDB = db(snmpTargetAddrTable), @@ -679,8 +672,9 @@ snmpTargetSpinLock(print) -> snmpTargetSpinLock(new) -> snmp_generic:variable_func(new, {snmpTargetSpinLock, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {snmpTargetSpinLock, volatile}); @@ -1080,5 +1074,3 @@ error(Reason) -> config_err(F, A) -> snmpa_error:config_err("[TARGET-MIB]: " ++ F, A). - - diff --git a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl index 69dce337ba..ce6dc21435 100644 --- a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl +++ b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -439,8 +439,9 @@ usmUserSpinLock(print) -> usmUserSpinLock(new) -> snmp_generic:variable_func(new, {usmUserSpinLock, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {usmUserSpinLock, volatile}); @@ -1191,29 +1192,7 @@ extract_new_key(Hash, OldKey, KeyChange) -> -define(i8(Int), Int band 255). mk_random(Len) when Len =< 20 -> - %% Use of yield(): - %% This will either schedule another process, or fail and invoke - %% the error_handler (in old versions). In either case, it is - %% safe to assume that now, reductions and garbage_collection have - %% changed in a non-deterministically way. - {_,_,A} = erlang:now(), - catch erlang:yield(), - {_,_,B} = erlang:now(), - catch erlang:yield(), - {_,_,C} = erlang:now(), - {D,_} = erlang:statistics(reductions), - {E,_} = erlang:statistics(runtime), - {F,_} = erlang:statistics(wall_clock), - {G,H,_} = erlang:statistics(garbage_collection), - catch erlang:yield(), - {_,_,C2} = erlang:now(), - {D2,_} = erlang:statistics(reductions), - {_,H2,_} = erlang:statistics(garbage_collection), - %% X(N) means we can use N bits from variable X: - %% A(16) B(16) C(16) D(16) E(8) F(16) G(8) H(16) - Rnd20 = [?i16(A),?i16(B),?i16(C),?i16(D),?i8(E),?i16(F), - ?i8(G),?i16(H),?i16(C2),?i16(D2),?i16(H2)], - lists:sublist(Rnd20, Len). + binary_to_list(crypto:strong_rand_bytes(Len)). split(0, Rest, FirstRev) -> {lists:reverse(FirstRev), Rest}; diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 722bd7ac5b..28e2bdbb96 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -845,8 +845,9 @@ vacmViewSpinLock(print) -> vacmViewSpinLock(new) -> snmp_generic:variable_func(new, volatile_db(vacmViewSpinLock)), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, volatile_db(vacmViewSpinLock)); @@ -1133,4 +1134,3 @@ error(Reason) -> config_err(F, A) -> snmpa_error:config_err("[VIEW-BASED-ACM-MIB]: " ++ F, A). - diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 642b1f7fc5..24007a4e63 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. 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 @@ -75,8 +75,9 @@ init(Vsns) -> ?vlog("init -> entry with" "~n Vsns: ~p", [Vsns]), - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), ets:insert(snmp_agent_table, {msg_id, random:uniform(2147483647)}), ets:insert(snmp_agent_table, {req_id, random:uniform(2147483647)}), init_counters(), @@ -771,21 +772,7 @@ generate_v3_report_msg(MsgID, MsgSecurityModel, Data, LocalEngineID, ContextEngineID, ContextName, SecData}, LocalEngineID, Log). -%% req_id(#scopedPdu{data = #pdu{request_id = ReqId}}) -> -%% ?vtrace("Report ReqId: ~p",[ReqId]), -%% ReqId; -%% req_id(_) -> -%% 0. % RFC2572, 7.1.3.c.4 - -%% maybe_generate_discovery1_report_msg() -> -%% case (catch DiscoveryHandler:handle_discovery1(Ip, Udp, EngineId)) of -%% {ok, Entry} when is_record(Entry, snmp_discovery_data1) -> -%% ok; -%% ignore -> -%% ok; -%% {error, Reason} -> - %% Response to stage 1 discovery message (terminating, i.e. from the manager) generate_discovery1_report_msg(MsgID, MsgSecurityModel, SecName, SecLevel, diff --git a/lib/snmp/src/agent/snmpa_net_if.erl b/lib/snmp/src/agent/snmpa_net_if.erl index 840d56d563..c813c57d56 100644 --- a/lib/snmp/src/agent/snmpa_net_if.erl +++ b/lib/snmp/src/agent/snmpa_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -297,14 +297,14 @@ socket_open(snmpUDPDomain = Domain, [IpPort | Opts]) -> Fd = list_to_integer(FdStr), ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", [Domain, IpPort, Opts, Fd]), - gen_udp_open(IpPort, [{fd, Fd} | Opts]); + gen_udp_open(0, [{fd, Fd} | Opts]); error -> case init:get_argument(snmpa_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", [Domain, IpPort, Opts, Fd]), - gen_udp_open(IpPort, [{fd, Fd} | Opts]); + gen_udp_open(0, [{fd, Fd} | Opts]); error -> ?vdebug("socket_open(~p, [~p | ~p])", [Domain, IpPort, Opts]), @@ -674,7 +674,7 @@ handle_recv( #state{mpd_state = MpdState, note_store = NS, log = Log} = S, #transport{socket = Socket} = Transport, From, Packet) -> - put(n1, erlang:now()), + put(n1, erlang:monotonic_time(micro_seconds)), LogF = fun(Type, Data) -> log(Log, Type, Data, From) @@ -1379,15 +1379,7 @@ do_close_log(_) -> %%% DEBUG FUNCTIONS %%%----------------------------------------------------------------- time_in_agent() -> - subtr(erlang:now(), get(n1)). - -subtr({X1,Y1,Z1}, {X1,Y1,Z2}) -> - Z1 - Z2; -subtr({X1,Y1,Z1}, {X1,Y2,Z2}) -> - ((Y1-Y2) * 1000000) + (Z1 - Z2); -subtr({X1,Y1,Z1}, {X2,Y2,Z2}) -> - ((X1 - X2) * 1000000000000) + ((Y1 - Y2) * 1000000) + (Z1 - Z2). - + erlang:monotonic_time(micro_seconds) - get(n1). %% ---------------------------------------------------------------- @@ -1637,10 +1629,3 @@ get_port_info(Id) -> %% ---------------------------------------------------------------- - -% i(F) -> -% i(F, []). - -% i(F, A) -> -% io:format("~p: " ++ F ++ "~n", [?MODULE|A]). - diff --git a/lib/snmp/src/agent/snmpa_usm.erl b/lib/snmp/src/agent/snmpa_usm.erl index 719ea4e356..c571e50517 100644 --- a/lib/snmp/src/agent/snmpa_usm.erl +++ b/lib/snmp/src/agent/snmpa_usm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. 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 @@ -645,8 +645,9 @@ get_des_salt() -> ets:insert(snmp_agent_table, {usm_des_salt, 0}), 0; _ -> % it doesn't exist, initialize - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), R = random:uniform(4294967295), ets:insert(snmp_agent_table, {usm_des_salt, R}), R @@ -677,8 +678,9 @@ get_aes_salt() -> ets:insert(snmp_agent_table, {usm_aes_salt, 0}), 0; _ -> % it doesn't exist, initialize - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), R = random:uniform(36893488147419103231), ets:insert(snmp_agent_table, {usm_aes_salt, R}), R diff --git a/lib/snmp/src/agent/snmpa_vacm.erl b/lib/snmp/src/agent/snmpa_vacm.erl index dadcf32543..281b2bd34a 100644 --- a/lib/snmp/src/agent/snmpa_vacm.erl +++ b/lib/snmp/src/agent/snmpa_vacm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. 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 @@ -305,8 +305,8 @@ dump_table() -> %% time dumping the table. unique_table_name(Pre) -> %% We want something that is guaranteed to be unique, - %% therefor we use erlang:now() instead of os:timestamp() - unique_table_name(Pre, erlang:now()). + %% therefor we use erlang:timestamp() instead of os:timestamp() + unique_table_name(Pre, erlang:timestamp()). unique_table_name(Pre, {_A, _B, C} = Now) -> {Date, Time} = calendar:now_to_datetime(Now), @@ -445,6 +445,3 @@ gc_tab(Oid) -> user_err(F, A) -> snmpa_error:user_err(F, A). - -% config_err(F, A) -> -% snmpa_error:config_err(F, A). diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index e7e54f5b7e..081163b368 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -28,6 +28,7 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {"5.1.1", [{restart_application, snmp}]}, {"5.1", [ % Only compiler changes ]}, {"5.0", [{restart_application, snmp}]}, @@ -46,6 +47,7 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {"5.1.1", [{restart_application, snmp}]}, {"5.1", [ % Only compiler changes ]}, {"5.0", [{restart_application, snmp}]}, diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index 2f065dddac..e7839c0792 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. 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 @@ -409,8 +409,9 @@ get_verbosity(Options) -> %%---------------------------------------------------------------------- init(From, MibFileName, Options) -> - {A,B,C} = now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), put(options, Options), put(verbosity, get_verbosity(Options)), put(description, get_description(Options)), diff --git a/lib/snmp/src/manager/snmpm_mpd.erl b/lib/snmp/src/manager/snmpm_mpd.erl index f8a7441c0a..5fc9d3655c 100644 --- a/lib/snmp/src/manager/snmpm_mpd.erl +++ b/lib/snmp/src/manager/snmpm_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -67,8 +67,9 @@ %%%----------------------------------------------------------------- init(Vsns) -> ?vdebug("init -> entry with ~p", [Vsns]), - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), snmpm_config:cre_counter(msg_id, random:uniform(2147483647)), snmpm_config:cre_counter(req_id, random:uniform(2147483647)), init_counters(), @@ -896,17 +897,6 @@ get_agent_engine_id(Name) -> is_known_engine_id(EngineID, {Addr, Port}) -> snmpm_config:is_known_engine_id(EngineID, Addr, Port). -%% is_known_engine_id(EngineID, Addr, Port) -> -%% snmpm_config:is_known_engine_id(EngineID, Addr, Port). - -% get_agent_engine_id(Addr, Port) -> -% case snmpm_config:get_agent_engine_id(Addr, Port) of -% {ok, Id} -> -% Id; -% _Error -> -% "" -% end. - %%----------------------------------------------------------------- %% Sequence number (msg-id & req-id) functions diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl index b4cc165d2e..e81383eeea 100644 --- a/lib/snmp/src/manager/snmpm_net_if.erl +++ b/lib/snmp/src/manager/snmpm_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -330,7 +330,7 @@ socket_params(Domain, {IpAddr, IpPort} = Addr, BindTo, CommonSocketOpts) -> end, case Family of inet -> - case init:get_argument(snmp_fd) of + case init:get_argument(snmpm_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), case BindTo of @@ -489,11 +489,6 @@ handle_call({verbosity, Verbosity}, _From, State) -> put(verbosity, Verbosity), {reply, ok, State}; -%% handle_call({system_info_updated, What}, _From, State) -> -%% ?vlog("received system_info_updated request with What = ~p", [What]), -%% {NewState, Reply} = handle_system_info_updated(State, What), -%% {reply, Reply, NewState}; - handle_call(get_log_type, _From, State) -> ?vlog("received get-log-type request", []), Reply = (catch handle_get_log_type(State)), @@ -816,7 +811,7 @@ handle_inform_request( ok; [] -> RePdu = make_response_pdu(Pdu), - Expire = t() + To, + Expire = snmp_misc:now(ms) + To, Rec = {Key, Expire, {Vsn, ACM, RePdu}}, ets:insert(snmpm_inform_request_table, Rec) end. @@ -876,7 +871,7 @@ maybe_send_inform_response( handle_inform_response_gc(#state{irb = IRB} = State) -> ets:safe_fixtable(snmpm_inform_request_table, true), - do_irgc(ets:first(snmpm_inform_request_table), t()), + do_irgc(ets:first(snmpm_inform_request_table), snmp_misc:now(ms)), ets:safe_fixtable(snmpm_inform_request_table, false), State#state{irgc = irgc_start(IRB)}. @@ -1023,110 +1018,6 @@ handle_disk_log(_Log, _Info, State) -> State. -%% mk_discovery_msg('version-3', Pdu, _VsnHdr, UserName) -> -%% ScopedPDU = #scopedPdu{contextEngineID = "", -%% contextName = "", -%% data = Pdu}, -%% Bytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), -%% MsgID = get(msg_id), -%% put(msg_id,MsgID+1), -%% UsmSecParams = -%% #usmSecurityParameters{msgAuthoritativeEngineID = "", -%% msgAuthoritativeEngineBoots = 0, -%% msgAuthoritativeEngineTime = 0, -%% msgUserName = UserName, -%% msgPrivacyParameters = "", -%% msgAuthenticationParameters = ""}, -%% SecBytes = snmp_pdus:enc_usm_security_parameters(UsmSecParams), -%% PduType = Pdu#pdu.type, -%% Hdr = #v3_hdr{msgID = MsgID, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, 0), -%% msgSecurityModel = ?SEC_USM, -%% msgSecurityParameters = SecBytes}, -%% Msg = #message{version = 'version-3', vsn_hdr = Hdr, data = Bytes}, -%% case (catch snmp_pdus:enc_message_only(Msg)) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end; -%% mk_discovery_msg(Version, Pdu, {Com, _, _, _, _}, UserName) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end. - - -%% mk_msg('version-3', Pdu, {Context, User, EngineID, CtxEngineId, SecLevel}, -%% MsgData) -> -%% %% Code copied from snmp_mpd.erl -%% {MsgId, SecName, SecData} = -%% if -%% tuple(MsgData), Pdu#pdu.type == 'get-response' -> -%% MsgData; -%% true -> -%% Md = get(msg_id), -%% put(msg_id, Md + 1), -%% {Md, User, []} -%% end, -%% ScopedPDU = #scopedPdu{contextEngineID = CtxEngineId, -%% contextName = Context, -%% data = Pdu}, -%% ScopedPDUBytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), - -%% PduType = Pdu#pdu.type, -%% V3Hdr = #v3_hdr{msgID = MsgId, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, SecLevel), -%% msgSecurityModel = ?SEC_USM}, -%% Message = #message{version = 'version-3', vsn_hdr = V3Hdr, -%% data = ScopedPDUBytes}, -%% SecEngineID = case PduType of -%% 'get-response' -> snmp_framework_mib:get_engine_id(); -%% _ -> EngineID -%% end, -%% case catch snmp_usm:generate_outgoing_msg(Message, SecEngineID, -%% SecName, SecData, SecLevel) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% {error, Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% Packet -> -%% Packet -%% end; -%% mk_msg(Version, Pdu, {Com, _User, _EngineID, _Ctx, _SecLevel}, _SecData) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% B when list(B) -> -%% B -%% end. - - -%% handle_system_info_updated(#state{log = {Log, _OldType}} = State, -%% audit_trail_log_type = _What) -> -%% %% Just to make sure, check that ATL is actually enabled -%% case snmpm_config:system_info(audit_trail_log) of -%% {ok, true} -> -%% {ok, Type} = snmpm_config:system_info(audit_trail_log_type), -%% NewState = State#state{log = {Log, Type}}, -%% {NewState, ok}; -%% _ -> -%% {State, {error, {adt_not_enabled}}} -%% end; -%% handle_system_info_updated(_State, _What) -> -%% ok. - handle_get_log_type(#state{log = {_Log, Value}} = State) -> %% Just to make sure, check that ATL is actually enabled case snmpm_config:system_info(audit_trail_log) of @@ -1257,13 +1148,6 @@ maybe_process_extra_info(_ExtraInfo) -> %% ------------------------------------------------------------------- -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - - -%% ------------------------------------------------------------------- - %% info_msg(F, A) -> %% ?snmpm_info("NET-IF server: " ++ F, A). @@ -1301,8 +1185,6 @@ proc_mem(P) when is_pid(P) -> _ -> undefined end. -%% proc_mem(_) -> -%% undefined. get_port_info(Id) -> @@ -1382,20 +1264,6 @@ counters() -> inc(Name) -> inc(Name, 1). inc(Name, N) -> snmpm_config:incr_stats_counter(Name, N). -%% get_counters() -> -%% Counters = counters(), -%% get_counters(Counters, []). - -%% get_counters([], Acc) -> -%% lists:reverse(Acc); -%% get_counters([Counter|Counters], Acc) -> -%% case snmpm_config:get_stats_counter(Counter) of -%% {ok, CounterVal} -> -%% get_counters(Counters, [{Counter, CounterVal}|Acc]); -%% _ -> -%% get_counters(Counters, Acc) -%% end. - %% ---------------------------------------------------------------- diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index a75122d0bb..00a9b82daa 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -467,27 +467,6 @@ cancel_async_request(UserId, ReqId) -> call({cancel_async_request, UserId, ReqId}). -%% discovery(UserId, BAddr) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, [], -%% ?DEFAULT_ASYNC_EXPIRE, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Config) when is_list(Config) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, Config, -%% ?DEFAULT_ASYNC_EXPIRE, ?EXTRA_INFO); - -%% discovery(UserId, BAddr, Expire) when is_integer(Expire) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, [], Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Config, Expire) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, Config, Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Port, Config, Expire) -> -%% discovery(UserId, BAddr, Port, Config, Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Port, Config, Expire, ExtraInfo) -> -%% call({discovery, self(), UserId, BAddr, Port, Config, Expire, ExtraInfo}). - - verbosity(Verbosity) -> case ?vvalidate(Verbosity) of Verbosity -> @@ -927,14 +906,6 @@ handle_call({cancel_async_request, UserId, ReqId}, _From, State) -> {reply, Reply, State}; -%% handle_call({discovery, Pid, UserId, BAddr, Port, Config, Expire, ExtraInfo}, -%% _From, State) -> -%% ?vlog("received discovery request", []), -%% Reply = (catch handle_discovery(Pid, UserId, BAddr, Port, Config, -%% Expire, ExtraInfo, State)), -%% {reply, Reply, State}; - - handle_call({load_mib, Mib}, _From, State) -> ?vlog("received load_mib request", []), case snmpm_config:load_mib(Mib) of @@ -988,13 +959,6 @@ handle_call(is_started, _From, State) -> IsStarted = is_started(State), {reply, IsStarted, State}; -%% handle_call({system_info_updated, Target, What}, _From, State) -> -%% ?vlog("received system_info_updated request: " -%% "~n Target: ~p" -%% "~n What: ~p", [Target, What]), -%% Reply = handle_system_info_updated(State, Target, What), -%% {reply, Reply, State}; - handle_call(get_log_type, _From, State) -> ?vlog("received get_log_type request", []), Reply = handle_get_log_type(State), @@ -1042,11 +1006,6 @@ handle_info({snmp_error, ReqId, Reason, Domain, Addr}, State) -> handle_snmp_error(Domain, Addr, ReqId, Reason, State), {noreply, State}; -%% handle_info({snmp_error, ReqId, Pdu, Reason, Addr, Port}, State) -> -%% ?vlog("received snmp_error message", []), -%% handle_snmp_error(Pdu, ReqId, Reason, Addr, Port, State), -%% {noreply, State}; - handle_info({snmp_pdu, Pdu, Domain, Addr}, State) -> ?vlog("received snmp_pdu message", []), @@ -1411,7 +1370,7 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> address = Addr, type = get, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1460,7 +1419,7 @@ handle_async_get_next(Pid, UserId, TargetName, Oids, SendOpts, State) -> address = Addr, type = get_next, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1516,7 +1475,7 @@ handle_async_get_bulk(Pid, address = Addr, type = get_bulk, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), {ok, ReqId}; @@ -1564,7 +1523,7 @@ handle_async_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, State) -> address = Addr, type = set, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1600,18 +1559,6 @@ handle_cancel_async_request(UserId, ReqId, _State) -> ?vlog("handle_cancel_async_request -> not found", []), {error, not_found} end. - - -%% handle_system_info_updated(#state{net_if = Pid, net_if_mod = Mod} = _State, -%% net_if = _Target, What) -> -%% case (catch Mod:system_info_updated(Pid, What)) of -%% {'EXIT', _} -> -%% {error, not_supported}; -%% Else -> -%% Else -%% end; -%% handle_system_info_updated(_State, Target, What) -> -%% {error, {bad_target, Target, What}}. handle_get_log_type(#state{net_if = Pid, net_if_mod = Mod}) -> case (catch Mod:get_log_type(Pid)) of @@ -1629,47 +1576,6 @@ handle_set_log_type(#state{net_if = Pid, net_if_mod = Mod}, NewType) -> Else end. - -%% handle_discovery(Pid, UserId, BAddr, Port, Config, Expire, ExtraInfo, State) -> -%% ?vtrace("handle_discovery -> entry with" -%% "~n Pid: ~p" -%% "~n UserId: ~p" -%% "~n BAddr: ~p" -%% "~n Port: ~p" -%% "~n Config: ~p" -%% "~n Expire: ~p", -%% [Pid, UserId, BAddr, Port, Config, Expire]), -%% case agent_data(default, default, "", Config) of -%% {ok, Addr, Port, Vsn, MsgData} -> -%% ?vtrace("handle_discovery -> send a ~p disco message", [Vsn]), -%% ReqId = send_discovery(Vsn, MsgData, BAddr, Port, ExtraInfo, -%% State), -%% ?vdebug("handle_discovery -> ReqId: ~p", [ReqId]), -%% MonRef = erlang:monitor(process, Pid), -%% ?vtrace("handle_discovery -> MonRef: ~p", [MonRef]), -%% Req = #request{id = ReqId, -%% user_id = UserId, -%% target = TargetName, -%% addr = BAddr, -%% port = Port, -%% type = get, -%% data = MsgData, -%% mon = MonRef, -%% discovery = true, -%% expire = t() + Expire}, -%% ets:insert(snmpm_request_table, Req), -%% gct_activate(State#state.gct), -%% {ok, ReqId}; - -%% Error -> -%% ?vinfo("failed retrieving agent data for discovery (get):" -%% "~n BAddr: ~p" -%% "~n Port: ~p" -%% "~n Error: ~p", [BAddr, Port, Error]), -%% Error -%% end. - - handle_sync_timeout(ReqId, From, State) -> ?vtrace("handle_sync_timeout -> entry with" "~n ReqId: ~p" @@ -1693,7 +1599,7 @@ handle_sync_timeout(ReqId, From, State) -> Req = Req0#request{ref = undefined, mon = undefined, from = undefined, - expire = t()}, + expire = snmp_misc:now(ms)}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), ok; @@ -2116,7 +2022,8 @@ do_handle_agent(DefUserId, DefMod, ok; InvalidResult -> - CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], + CallbackArgs = + [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, InvalidResult) catch @@ -2212,7 +2119,8 @@ do_handle_agent(DefUserId, DefMod, end; T:E -> - CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], + CallbackArgs = + [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, T, E) end. @@ -3024,7 +2932,7 @@ cancel_timer(Ref) -> handle_gc(GCT) -> ets:safe_fixtable(snmpm_request_table, true), - case do_gc(ets:first(snmpm_request_table), t()) of + case do_gc(ets:first(snmpm_request_table), snmp_misc:now(ms)) of 0 -> gct_deactivate(GCT); _ -> @@ -3098,23 +3006,11 @@ send_set_request(VarsAndVals, Vsn, MsgData, Domain, Addr, ExtraInfo, Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo), Pdu#pdu.request_id. -%% send_discovery(Vsn, MsgData, Addr, Port, ExtraInfo, -%% #state{net_if = NetIf, -%% net_if_mod = Mod}) -> -%% Pdu = make_discovery_pdu(), -%% Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo), -%% Pdu#pdu.request_id. - - %%---------------------------------------------------------------------- %% %%---------------------------------------------------------------------- -%% make_discovery_pdu() -> -%% Oids = [?sysObjectID_instance, ?sysDescr_instance, ?sysUpTime_instance], -%% make_pdu_impl(get, Oids). - make_pdu(set, VarsAndVals, MiniMIB) -> VBs = [var_and_value_to_varbind(VAV, MiniMIB) || VAV <- VarsAndVals], make_pdu_impl(set, VBs); @@ -3397,7 +3293,7 @@ gct_init(#gct{parent = Parent, timeout = Timeout} = State) -> gct(State, Timeout). gct(#gct{parent = Parent, state = active} = State, Timeout) -> - T = t(), + T = snmp_misc:now(ms), receive {stop, Parent} -> ok; @@ -3455,7 +3351,7 @@ gct(#gct{parent = Parent, state = idle} = State, Timeout) -> end. new_timeout(T1, T2) -> - case T1 - (t() - T2) of + case T1 - (snmp_misc:now(ms) - T2) of T when (T > 0) -> T; _ -> @@ -3475,11 +3371,6 @@ maybe_demonitor(undefined) -> maybe_demonitor(MonRef) -> erlang:demonitor(MonRef). -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - mk_target_name(Domain, Addr, Config) -> snmpm_config:mk_target_name(Domain, Addr, Config). @@ -3518,12 +3409,6 @@ call(Req) -> call(Req, To) -> gen_server:call(?SERVER, Req, To). -%% cast(Msg) -> -%% gen_server:cast(?SERVER, Msg). - -%% info_msg(F, A) -> -%% ?snmpm_info("Server: " ++ F, A). - warning_msg(F, A) -> ?snmpm_warning("Server: " ++ F, A). @@ -3599,20 +3484,3 @@ note_store_info(Pid) -> %%---------------------------------------------------------------------- - - -%%---------------------------------------------------------------------- -%% Debug -%%---------------------------------------------------------------------- - -% sz(L) when is_list(L) -> -% length(lists:flatten(L)); -% sz(B) when is_binary(B) -> -% size(B). - -%% p(F) -> -%% p(F, []). - -%% p(F, A) -> -%% io:format("~w:" ++ F ++ "~n", [?MODULE | A]). - diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index c36cee2a53..cc438977c9 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -101,21 +101,14 @@ sleep(Time) -> %% Returns time in ms = sec/1000 % now() -> now(ms). now(ms) -> - Now = erlang:now(), - element(1,Now)*1000000000+ - element(2,Now)*1000+ - (element(3,Now) div 1000); + erlang:monotonic_time(milli_seconds); + %% Returns time in cs = sec/100 now(cs) -> - Now = erlang:now(), - element(1,Now)*100000000+ - element(2,Now)*100+ - (element(3,Now) div 10000); + erlang:monotonic_time(100); + now(sec) -> - Now = erlang:now(), - element(1,Now)*1000000+ - element(2,Now)+ - (element(3,Now) div 1000000). + erlang:monotonic_time(seconds). is_crypto_supported(Alg) -> @@ -479,7 +472,3 @@ format_val('OBJECT IDENTIFIER', _, Val, MiniMib) -> io_lib:format("~w", [NVal]); format_val(_, _, Val, _MiniMib) -> io_lib:format("~p", [Val]). - - - - diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index f27c31db03..c9192158ef 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. 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 @@ -69,7 +69,7 @@ print2(_Verbosity,Format,Arguments) -> timestamp() -> - format_timestamp(now()). + format_timestamp(os:timestamp()). format_timestamp({_N1, _N2, N3} = Now) -> {Date, Time} = calendar:now_to_datetime(Now), @@ -162,4 +162,3 @@ validate(log) -> log; validate(debug) -> debug; validate(trace) -> trace; validate(_) -> silence. - diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index b4770ad0a9..a28cdf6aca 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -426,10 +426,6 @@ -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/src/agent/snmpa_atl.hrl"). -%% -include_lib("snmp/include/SNMP-COMMUNITY-MIB.hrl"). -%% -include_lib("snmp/include/SNMP-VIEW-BASED-ACM-MIB.hrl"). -%% -include_lib("snmp/include/SNMP-USER-BASED-SM-MIB.hrl"). - -define(klas1, [1,3,6,1,2,1,7]). -define(klas2, [1,3,6,1,2,1,9]). @@ -1612,7 +1608,8 @@ app_dir(App) -> create_local_db_dir(Config) when is_list(Config) -> ?P(create_local_db_dir), DataDir = snmp_test_lib:lookup(data_dir, Config), - T = erlang:now(), + UName = erlang:unique_integer([positive]), + T = {UName, UName, UName}, [As,Bs,Cs] = [integer_to_list(I) || I <- tuple_to_list(T)], DbDir = filename:join([DataDir, As, Bs, Cs]), ok = del_dir(DbDir, 3), @@ -2448,10 +2445,6 @@ mul_cases() -> ]. -%% multiple_reqs_3(_X) -> -%% {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}. - - mul_cases_2() -> [ mul_get_2, @@ -3200,19 +3193,18 @@ v1_get_next_p() -> %% 4.1.3:2 gn([[tTooBig]]), io:format("We currently don't handle tooBig correct!!!\n"), -% ?line ?expect3(tooBig, 0, [{[tTooBig], 'NULL'}]), + ?line ?expect3(tooBig, 0, any), %% 4.1.3:3 gn([[tGenErr1]]), -% ?line expect(40, genErr, 1, [{[tGenErr1], 'NULL'}]), + ?line ?expect3(genErr, 1, any), gn([[tGenErr2]]), -% ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]), + ?line ?expect3(genErr, 1, any), gn([[sysDescr], [tGenErr3]]), -% ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'}, -% {[tGenErr3], 'NULL'}]). + ?line ?expect3(genErr, 2, any). v1_set_p() -> @@ -3451,8 +3443,7 @@ v2_set_p() -> %% Req. OLD-SNMPEA-MIB table_test() -> io:format("Testing simple get, next and set on communityTable...~n"), -%% {[147,214,36,45], "public", 2, readWrite}. -%% {[147,214,36,45], "standard trap", 2, read}. + Key1c3 = [intCommunityViewIndex,get(mip),is("public")], Key2c3 = [intCommunityViewIndex,get(mip),is("standard trap")], Key1c4 = [intCommunityAccess,get(mip),is("public")], @@ -3620,8 +3611,6 @@ notify(Pid, What) -> %% Req: system group, OLD-SNMPEA-MIB, Klas1 big_test() -> - %% put(sname, {?MODULE, big_test}), - %% put(verbosity, trace), ?DBG("big_test -> testing simple next/get/set @ master agent...",[]), simple_standard_test(), @@ -5691,8 +5680,7 @@ loop_mib_1(suite) -> []; loop_mib_1(Config) when is_list(Config) -> ?P(loop_mib_1), ?LOG("loop_mib_1 -> initiate case",[]), - %% snmpa:verbosity(master_agent,debug), - %% snmpa:verbosity(mib_server,info), + {_SaNode, _MgrNode, _MibDir} = init_case(Config), ?DBG("loop_mib_1 -> ~n" "\tSaNode: ~p~n" @@ -6643,7 +6631,6 @@ otp8395({init, Config}) when is_list(Config) -> %% {ok, AgentNode} = start_node(agent), - %% {ok, SubAgentNode} = start_node(sub_agent), {ok, ManagerNode} = start_node(manager), %% -- @@ -6654,16 +6641,9 @@ otp8395({init, Config}) when is_list(Config) -> AgentMnesiaDir = join([AgentDbDir, "mnesia"]), mnesia_init(AgentNode, AgentMnesiaDir), - %% SubAgentDir = ?config(sub_agent_dir, Config), - %% SubAgentMnesiaDir = join([SubAgentDir, "mnesia"]), - %% mnesia_init(SubAgentNode, SubAgentMnesiaDir), - - %% ok = mnesia_create_schema(AgentNode, [AgentNode, SubAgentNode]), - %% ok = mnesia:create_schema([AgentNode, SubAgentNode]), mnesia_create_schema(AgentNode, [AgentNode]), mnesia_start(AgentNode), - %% mnesia_start(SubAgentNode), %% -- %% Host & IP @@ -6749,11 +6729,6 @@ otp8395({fin, Config}) when is_list(Config) -> ?DBG("otp8395(fin) -> stop agent node", []), stop_node(AgentNode), - - %% SubAgentNode = ?config(sub_agent_node, Config), - %% stop_node(SubAgentNode), - - %% - %% Stop the manager node %% @@ -6970,20 +6945,6 @@ process_options(Defaults, _Opts) -> %% process_options(Defaults, Opts, []). Defaults. -%% process_options([], _Opts, Acc) -> -%% lists:reverse(Acc); -%% process_options([{Key, DefaultValue}|Defaults], Opts, Acc) -> -%% case lists:keysearch(Key, 1, Opts) of -%% {value, {Key, Value}} when is_list-> - - -%% snmp_app_env_init(Node, Entity, Conf) -> -%% rpc:call(Node, snmp_app_env_init, [Entity, Conf]). - -%% snmp_app_env_init(Entity, Conf) -> -%% application:unload(snmp), -%% application:load(snmp), -%% application:set_env(snmp, Entity, Conf). start_stdalone_agent(Node, Config) -> rpc:call(Node, ?MODULE, start_stdalone_agent, [Config]). @@ -7063,9 +7024,6 @@ do_info(MaNode) -> tree_size_bytes, db_memory]}], verify_info(Info, Keys), - %% OldInfo = snmpa:old_info_format(Info), - %% ?DBG("info_test1 -> OldInfo: ~n~p", [OldInfo]), - %% verify_old_info(OldInfo), ok. verify_info([], []) -> @@ -7107,21 +7065,6 @@ verify_subinfo(Info0, [Key|Keys]) -> Info -> verify_subinfo(Info, Keys) end. - -%% verify_old_info(Info) -> -%% Keys = [vsns, subagents, loaded_mibs, -%% tree_size_bytes, process_memory, db_memory], -%% verify_old_info(Keys, Info). - -%% verify_old_info([], _) -> -%% ok; -%% verify_old_info([Key|Keys], Info) -> -%% case lists:keymember(Key, 1, Info) of -%% true -> -%% verify_old_info(Keys, Info); -%% false -> -%% ?FAIL({missing_old_info, Key}) -%% end. %% Index String - string used in index is(S) -> [length(S) | S]. @@ -7184,8 +7127,6 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) -> reset_usm_mgr(Dir) -> snmp_agent_test_lib:reset_usm_mgr(Dir). -%% update_community(Vsns, Dir) -> -%% snmp_agent_test_lib:update_community(Vsns, Dir). update_vacm(Vsn, Dir) -> snmp_agent_test_lib:update_vacm(Vsn, Dir). @@ -7196,8 +7137,6 @@ write_community_conf(Dir, Conf) -> write_target_addr_conf(Dir, Conf) -> snmp_agent_test_lib:write_target_addr_conf(Dir, Conf). -%% write_target_addr_conf(Dir, ManagerIp, UDP, Vsns) -> -%% snmp_agent_test_lib:write_target_addr_conf(Dir, ManagerIp, UDP, Vsns). rewrite_target_addr_conf(Dir, NewPort) -> snmp_agent_test_lib:rewrite_target_addr_conf(Dir, NewPort). @@ -7218,10 +7157,6 @@ reset_target_params_conf(Dir) -> write_notify_conf(Dir) -> snmp_agent_test_lib:write_notify_conf(Dir). -%% write_view_conf(Dir) -> -%% snmp_agent_test_lib:write_view_conf(Dir). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% copy_file(From, To) -> @@ -7381,9 +7316,6 @@ lists_key1search(Key, List) when is_atom(Key) -> end. -%% regs() -> -%% lists:sort(registered()). - %% ------ join(Parts) -> diff --git a/lib/snmp/test/snmp_app_test.erl b/lib/snmp/test/snmp_app_test.erl index 9b13e7cf1a..1e68b4e2c8 100644 --- a/lib/snmp/test/snmp_app_test.erl +++ b/lib/snmp/test/snmp_app_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -32,8 +32,6 @@ modules/1, exportall/1, app_depend/1, - undef_funcs/1, - start_and_stop_empty/1, start_and_stop_with_agent/1, @@ -59,7 +57,6 @@ all() -> modules, exportall, app_depend, - undef_funcs, {group, start_and_stop} ], Cases. @@ -131,9 +128,6 @@ end_per_suite(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test server callbacks -init_per_testcase(undef_funcs, Config) -> - Config2 = lists:keydelete(watchdog, 1, Config), - [{watchdog, ?WD_START(?MINS(10))} | Config2]; init_per_testcase(_Case, Config) -> Config. @@ -293,88 +287,6 @@ check_apps([App|Apps]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - App = snmp, - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - {ok, XRef} = xref:start(XRefTestName), - ok = xref:set_default(XRef, - [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - {ok, XRefName} = xref:add_release(XRef, Root, {name,XRefName}), - {ok, App} = xref:replace_application(XRef, App, EbinDir), - {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), - xref:stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []). - -valid_undef(crypto = CalledMod) -> - case (catch CalledMod:version()) of - Version when is_list(Version) -> - %% The called module was crypto and the version - %% function returns a valid value. - %% This means that the function is - %% actually undefined... - true; - _ -> - %% The called module was crypto but the version - %% function does *not* return a valid value. - %% This means the crypto was not actually not - %% build, which is an case snmp handles. - false - end; -valid_undef(_) -> - true. - - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - %% If the called module is crypto, then we will *not* - %% fail if crypto is not built (since crypto is actually - %% not built for all platforms) - case valid_undef(Mod2) of - true -> - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls( - Undefs, AppModules, [AppUndef|AppUndefs]); - false -> - io:format("skipping ~p (calling ~w:~w/~w)~n", - [Mod, Mod2, Func2, Ar2]), - analyze_undefined_function_calls(Undefs, - AppModules, AppUndefs) - end; - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/snmp/test/snmp_appup_mgr.erl b/lib/snmp/test/snmp_appup_mgr.erl index 6648ce9dbe..b07f8b3c72 100644 --- a/lib/snmp/test/snmp_appup_mgr.erl +++ b/lib/snmp/test/snmp_appup_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -140,7 +140,7 @@ handle_req(#agent{host = Host, port = Port}, Reqs) -> {ok, ReqId} = snmpm:ag(?USER_ID, Host, Port, Oids), p("issued get-request (~w) for: ~s", [ReqId, oid_descs(Descs)]), ReqTimer = erlang:send_after(?REQ_TIMEOUT, self(), {req_timeout, ReqId}), - {ReqId, erlang:now(), ReqTimer}. + {ReqId, erlang:monotonic_time(micro_seconds), ReqTimer}. oid_descs([]) -> []; @@ -163,7 +163,7 @@ handle_req_timeout(#state{ids = IDs0} = State, ReqId) -> handle_snmp(#state{ids = IDs0} = S, {error, ReqId, Reason}) -> case lists:keysearch(ReqId, 1, IDs0) of {value, {ReqId, T, Ref}} -> - Diff = timer:now_diff(erlang:now(), T), + Diff = erlang:monotonic_time(micro_seconds) - T, p("SNMP error regarding outstanding request after ~w microsec:" "~n ReqId: ~w" "~n Reason: ~w", [Diff, ReqId, Reason]), @@ -187,7 +187,7 @@ handle_snmp(State, {agent, Addr, Port, SnmpInfo}) -> handle_snmp(#state{ids = IDs0} = S, {pdu, Addr, Port, ReqId, SnmpResponse}) -> case lists:keysearch(ReqId, 1, IDs0) of {value, {ReqId, T, Ref}} -> - Diff = timer:now_diff(erlang:now(), T), + Diff = erlang:monotonic_time(micro_seconds) - T, p("SNMP pdu regarding outstanding request after ~w microsec:" "~n ReqId: ~w" "~n Addr: ~w" diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl index 7f5d11c0e7..dacedf0847 100644 --- a/lib/snmp/test/snmp_conf_test.erl +++ b/lib/snmp/test/snmp_conf_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -117,7 +117,7 @@ check_mandatory(Config) when is_list(Config) -> {b, mandatory}, {d, {value, 20202}}, {e, {value, "kalle"}}], - ?line {ok, L1} = verify_mandatory(A1, B1), + ?line {ok, _L1} = verify_mandatory(A1, B1), ?DBG("check_mandatory -> L1: ~p", [L1]), A2 = [{a, hej}, {c, 10}, {d, 10101}, {f, 10.88}], B2 = [{a, {value, hejsan}}, diff --git a/lib/snmp/test/snmp_log_test.erl b/lib/snmp/test/snmp_log_test.erl index fb7285110f..ed71dba23f 100644 --- a/lib/snmp/test/snmp_log_test.erl +++ b/lib/snmp/test/snmp_log_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -633,11 +633,11 @@ log_to_txt3(Config) when is_list(Config) -> log_reader_log_to(Reader, fun() -> I = disk_log:info(Log), - T1 = t(), + T1 = snmp_misc:now(ms), R = snmp_log:log_to_txt(Log, LogFile, Dir, Mibs, TxtFile), - T2 = t(), - io:format(user, + T2 = snmp_misc:now(ms), + io:format(user, "Time converting file: ~w ms~n", [T2 - T1]), {R, I} @@ -704,10 +704,10 @@ log_writer_start(Name, File, Size, Repair) -> log_writer_stop(Pid) -> Pid ! {stop, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {'EXIT', Pid, normal} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to stop the writer", [_T2 - _T1]), ok after 60000 -> @@ -721,10 +721,10 @@ log_writer_info(Pid) -> log_writer_sleep(Pid, Time) -> Pid ! {sleep, Time, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {sleeping, Pid} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to put the writer to sleep", [_T2 - _T1]), ok; {'EXIT', Pid, Reason} -> @@ -793,10 +793,10 @@ lp(F, A) -> log_reader_start() -> Pid = spawn_link(?MODULE, log_reader_main, [self()]), - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {started, Pid} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to start the reader", [_T2 - _T1]), {ok, Pid}; {'EXIT', Pid, Reason} -> @@ -807,10 +807,10 @@ log_reader_start() -> log_reader_stop(Pid) -> Pid ! {stop, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {'EXIT', Pid, normal} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to put the reader to eleep", [_T2 - _T1]), ok after 1000 -> @@ -1124,8 +1124,3 @@ join(D, F) -> p(Case) -> io:format(user, "test case: ~w~n", [Case]). - -%% Time in milli sec -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index f37e957dae..ba674edce3 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -2169,7 +2169,6 @@ register_usm_user_using_function(Conf) when is_list(Conf) -> %% -- p("done"), ok. -%% ?SKIP(not_yet_implemented). %% @@ -2259,8 +2258,9 @@ create_and_increment(Conf) when is_list(Conf) -> ?line {ok, _Pid} = snmpm_config:start_link(Opts), %% Random init - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), StartVal = random:uniform(2147483647), IncVal = 42, diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index 5e611340a3..72c7452ec4 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -30,7 +30,7 @@ lookup/2, replace_config/3, set_config/3, get_config/2, get_config/3]). -export([fail/3, skip/3]). --export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). +-export([hours/1, minutes/1, seconds/1, sleep/1]). -export([flush_mqueue/0, trap_exit/0, trap_exit/1]). -export([ping/1, local_nodes/0, nodes_on/1]). -export([start_node/2]). @@ -334,14 +334,6 @@ skip(Reason, Module, Line) -> %% Time related function %% -millis() -> - erlang:now(). - -millis_diff(A,B) -> - T1 = (element(1,A)*1000000) + element(2,A) + (element(3,A)/1000000), - T2 = (element(1,B)*1000000) + element(2,B) + (element(3,B)/1000000), - T1 - T2. - hours(N) -> trunc(N * 1000 * 60 * 60). minutes(N) -> trunc(N * 1000 * 60). seconds(N) -> trunc(N * 1000). @@ -628,4 +620,3 @@ format_timestamp({_N1, _N2, N3} = Now) -> io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), lists:flatten(FormatDate). - diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 9b7609b831..fd584880da 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -1,8 +1,8 @@ -%%<copyright> -%% <year>2002-2014</year> -%% <holder>Ericsson AB, All Rights Reserved</holder> -%%</copyright> -%%<legalnotice> +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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 @@ -15,7 +15,7 @@ %% under the License. %% %% The Initial Developer of the Original Code is Ericsson AB. -%%</legalnotice> +%% %CopyrightEnd% %% %%---------------------------------------------------------------------- %% Purpose: Define common macros for testing @@ -73,8 +73,6 @@ -endif. -define(SLEEP(MSEC), snmp_test_lib:sleep(MSEC)). --define(M(), snmp_test_lib:millis()). --define(MDIFF(A,B), snmp_test_lib:millis_diff(A,B)). %% - Process utility macros - @@ -149,4 +147,3 @@ -define(PRINT(P,F,A), snmp_test_lib:print(P,?MODULE,?LINE,F,A)). - diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 8cb6ec588e..1bf7efc695 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -188,8 +188,9 @@ receive_trap(Timeout) -> init({Options, CallerPid}) -> put(sname, mgr), put(verbosity, debug), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), case (catch is_options_ok(Options)) of true -> put(debug, get_value(debug, Options, false)), @@ -1135,4 +1136,3 @@ d(_,_F,_A) -> formated_timestamp() -> snmp_test_lib:formated_timestamp(). - diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 345cc790f2..67adf0a34f 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2014. 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 @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.1.1 +SNMP_VSN = 5.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml index 429ef3c849..b8a03c350a 100644 --- a/lib/ssh/doc/src/ssh_channel.xml +++ b/lib/ssh/doc/src/ssh_channel.xml @@ -88,7 +88,7 @@ <fsummary>Makes a synchronous call to a channel.</fsummary> <type> <v>ChannelRef = pid() </v> - <d>As returned by <c>start_link/4</c></d> + <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> <v>Msg = term()</v> <v>Timeout = timeout()</v> <v>Reply = term()</v> @@ -112,7 +112,7 @@ ChannelRef and returns ok.</fsummary> <type> <v>ChannelRef = pid()</v> - <d>As returned by <c>start_link/4</c></d> + <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> <v>Msg = term()</v> </type> <desc> @@ -129,8 +129,8 @@ <name>enter_loop(State) -> _ </name> <fsummary>Makes an existing process an ssh_channel process.</fsummary> <type> - <v>State = term() - as returned by - <seealso marker = "#init-1">ssh_channel:init/1</seealso></v> + <v>State = term()</v> + <d>as returned by <seealso marker = "#init-1">ssh_channel:init/1</seealso></d> </type> <desc> <p>Makes an existing process an <c>ssh_channel</c> @@ -188,7 +188,7 @@ <name>reply(Client, Reply) -> _</name> <fsummary>Sends a reply to a client.</fsummary> <type> - <v>Client - opaque to the user, see explanation below</v> + <v>Client = opaque()</v> <v>Reply = term()</v> </type> <desc> @@ -259,7 +259,7 @@ <v>State = term()</v> <d>Internal state of the channel.</d> <v>Extra = term()</v> - <d>Passed “as-is” from the <c>{advanced,Extra}</c> + <d>Passed "as-is" from the <c>{advanced,Extra}</c> part of the update instruction.</d> </type> <desc> @@ -313,13 +313,15 @@ <c>ssh_channel:call/[2,3]</c>.</fsummary> <type> <v>Msg = term()</v> - <v>From = Opaque to the user, is to be used as argument to - ssh_channel:reply/2</v> + <v>From = opaque()</v> + <d>Is to be used as argument to + <seealso marker="#reply-2">ssh_channel:reply/2</seealso></d> <v>State = term()</v> <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()} | {noreply, NewState} | {noreply , NewState, timeout()} | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v> - <v>Reply = term() - will be the return value of ssh_channel:call/[2,3]</v> + <v>Reply = term()</v> + <d>Will be the return value of <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso></d> <v>NewState = term()</v> <v>Reason = term()</v> </type> @@ -418,7 +420,7 @@ <func> <name>Module:terminate(Reason, State) -> _</name> <fsummary>Does cleaning up before channel process termination. -</fsummary> + </fsummary> <type> <v>Reason = term()</v> <v>State = term()</v> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 02970bfa42..643130fe6b 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -70,10 +70,28 @@ <desc><p>The <c><![CDATA[apread]]></c> function reads from a specified position, combining the <c><![CDATA[position]]></c> and <c><![CDATA[aread]]></c> functions.</p> - <p><seealso marker="#apread/3">ssh_sftp:apread/4</seealso></p> </desc> + <p><seealso marker="#apread-4">ssh_sftp:apread/4</seealso></p> </desc> </func> <func> + <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> + <fsummary>Writes asynchronously to an open file.</fsummary> + <type> + <v>ChannelPid = pid()</v> + <v>Handle = term()</v> + <v>Position = integer()</v> + <v>Len = integer()</v> + <v>Data = binary()</v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> + </type> + <desc> + <p><c><![CDATA[apwrite]]></c> writes on a specified position, combining + the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> + <p><seealso marker="#awrite-3">ssh_sftp:awrite/3</seealso> </p></desc> + </func> + + <func> <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> @@ -95,23 +113,7 @@ </desc> </func> - <func> - <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> - <fsummary>Writes asynchronously to an open file.</fsummary> - <type> - <v>ChannelPid = pid()</v> - <v>Handle = term()</v> - <v>Position = integer()</v> - <v>Len = integer()</v> - <v>Data = binary()</v> - <v>Timeout = timeout()</v> - <v>Reason = term()</v> - </type> - <desc> - <p><c><![CDATA[apwrite]]></c> writes on a specified position, combining - the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> - <p><seealso marker="#awrite/3">ssh_sftp:awrite/3</seealso> </p></desc> - </func> + <func> <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason}</name> @@ -163,7 +165,7 @@ </type> <desc> <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#delete/1">file:delete/1</seealso></p> + <seealso marker="kernel:file#delete-1">file:delete/1</seealso></p> </desc> </func> @@ -232,7 +234,7 @@ <desc> <p>Creates a symbolic link pointing to <c><![CDATA[Target]]></c> with the name <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#make_symlink/2">file:make_symlink/2</seealso></p> + <seealso marker="kernel:file#make_symlink-2">file:make_symlink/2</seealso></p> </desc> </func> @@ -297,7 +299,7 @@ <desc> <p>Opens a handle to a tar file on the server, associated with <c>ChannelPid</c>. The handle can be used for remote tar creation and extraction, as defined by the - <seealso marker="stdlib:erl_tar#init/3">erl_tar:init/3</seealso> function. + <seealso marker="stdlib:erl_tar#init-3">erl_tar:init/3</seealso> function. </p> <p> For code exampel see Section @@ -387,7 +389,7 @@ <desc> <p>The <c><![CDATA[pread]]></c> function reads from a specified position, combining the <c><![CDATA[position]]></c> and <c><![CDATA[read]]></c> functions.</p> - <p><seealso marker="#read/4">ssh_sftp:read/4</seealso></p> + <p><seealso marker="#read-4">ssh_sftp:read/4</seealso></p> </desc> </func> @@ -406,7 +408,7 @@ <desc> <p>The <c><![CDATA[pread]]></c> function writes to a specified position, combining the <c><![CDATA[position]]></c> and <c><![CDATA[write]]></c> functions.</p> - <p><seealso marker="#write/3">ssh_sftp:write/3</seealso></p> + <p><seealso marker="#write-3">ssh_sftp:write/3</seealso></p> </desc> </func> @@ -449,7 +451,7 @@ <desc> <p>Reads a file from the server, and returns the data in a binary, like - <seealso marker="kernel:file#read_file/1">file:read_file/1</seealso></p> + <seealso marker="kernel:file#read_file-1">file:read_file/1</seealso></p> </desc> </func> @@ -468,7 +470,7 @@ <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the file specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, - like <seealso marker="kernel:file#read_file_info/2">file:read_file_info/2</seealso></p> + like <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso></p> </desc> </func> @@ -485,7 +487,7 @@ <desc> <p>Reads the link target from the symbolic link specified by <c><![CDATA[name]]></c>, like - <seealso marker="kernel:file#read_link/1">file:read_link/1</seealso></p> + <seealso marker="kernel:file#read_link-1">file:read_link/1</seealso></p> </desc> </func> @@ -504,7 +506,7 @@ <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the symbolic link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, like - <seealso marker="kernel:file#read_link_info/2">file:read_link_info/2</seealso></p> + <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso></p> </desc> </func> @@ -522,7 +524,7 @@ <desc> <p>Renames a file named <c><![CDATA[OldName]]></c> and gives it the name <c><![CDATA[NewName]]></c>, like - <seealso marker="kernel:file#rename/2">file:rename/2</seealso></p> + <seealso marker="kernel:file#rename-2">file:rename/2</seealso></p> </desc> </func> @@ -580,26 +582,7 @@ </type> <desc> <p>Stops an SFTP channel. Does not close the SSH connection. - Use <seealso marker="ssh#close/1">ssh:close/1</seealso> to close it.</p> - </desc> - </func> - - <func> - <name>write_file(ChannelPid, File, Iolist) -></name> - <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> - <fsummary>Writes a file.</fsummary> - <type> - <v>ChannelPid = pid()</v> - <v>File = string()</v> - <v>Iolist = iolist()</v> - <v>Timeout = timeout()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Writes a file to the server, like <seealso - marker="kernel:file#write_file/2">file:write_file/2</seealso> The - file is created if it does not exist. The file is overwritten - if it exists.</p> + Use <seealso marker="ssh#close-1">ssh:close/1</seealso> to close it.</p> </desc> </func> @@ -617,9 +600,9 @@ </type> <desc> <p>Writes <c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. - The file is to be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, Reason}]]></c> - otherwise.</p> + The file is to be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> + flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, Reason}]]></c> + otherwise.</p> <p>Typical error reasons:</p> <taglist> <tag><c><![CDATA[ebadf]]></c></tag> @@ -633,7 +616,26 @@ </taglist> </desc> </func> - + + <func> + <name>write_file(ChannelPid, File, Iolist) -></name> + <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> + <fsummary>Writes a file.</fsummary> + <type> + <v>ChannelPid = pid()</v> + <v>File = string()</v> + <v>Iolist = iolist()</v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Writes a file to the server, like <seealso + marker="kernel:file#write_file-2">file:write_file/2</seealso> The + file is created if it does not exist. The file is overwritten + if it exists.</p> + </desc> + </func> + <func> <name>write_file_info(ChannelPid, Name, Info) -></name> <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, Reason}</name> @@ -647,11 +649,11 @@ </type> <desc> <p>Writes file information from a <c><![CDATA[file_info]]></c> record to the - file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#write_file_info/2">file:write_file_info/[2,3]</seealso></p> + file specified by <c><![CDATA[Name]]></c>, like + <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso></p> </desc> </func> </funcs> - + </erlref> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index e1f2e059e8..4dea284071 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -70,6 +70,7 @@ undecoded_packet_length, % integer() key_exchange_init_msg, % #ssh_msg_kexinit{} renegotiate = false, % boolean() + last_size_rekey = 0, connection_queue, address, port, @@ -635,7 +636,8 @@ handle_event(renegotiate, StateName, State) -> %% Rekey due to sent data limit reached? handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> - {ok, [{send_oct,Sent}]} = inet:getstat(State#state.socket, [send_oct]), + {ok, [{send_oct,Sent0}]} = inet:getstat(State#state.socket, [send_oct]), + Sent = Sent0 - State#state.last_size_rekey, MaxSent = proplists:get_value(rekey_limit, State#state.opts, 1024000000), timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, [self(), data_size]), case Sent >= MaxSent of @@ -645,7 +647,8 @@ handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, key_exchange_init_msg = KeyInitMsg, - renegotiate = true})}; + renegotiate = true, + last_size_rekey = Sent0})}; _ -> {next_state, connected, next_packet(State)} end; diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index c264eabc78..bab688f226 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -508,12 +508,12 @@ init([Cm, ChannelId, Options]) -> %%-------------------------------------------------------------------- handle_call({{timeout, infinity}, wait_for_version_negotiation}, From, #state{xf = #ssh_xfer{vsn = undefined} = Xf} = State) -> - {noreply, State#state{xf = Xf#ssh_xfer{vsn = From}}}; + {noreply, State#state{xf = Xf#ssh_xfer{vsn = {wait, From, undefined}}}}; handle_call({{timeout, Timeout}, wait_for_version_negotiation}, From, #state{xf = #ssh_xfer{vsn = undefined} = Xf} = State) -> - timer:send_after(Timeout, {timeout, undefined, From}), - {noreply, State#state{xf = Xf#ssh_xfer{vsn = From}}}; + TRef = erlang:send_after(Timeout, self(), {timeout, undefined, From}), + {noreply, State#state{xf = Xf#ssh_xfer{vsn = {wait, From, TRef}}}}; handle_call({_, wait_for_version_negotiation}, _, State) -> {reply, ok, State}; @@ -865,7 +865,12 @@ do_handle_reply(#state{xf = Xf} = State, case Xf#ssh_xfer.vsn of undefined -> ok; - From -> + {wait, From, TRef} -> + if is_reference(TRef) -> + erlang:cancel_timer(TRef); + true -> + ok + end, ssh_channel:reply(From, ok) end, State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest}; diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index c9441a46b0..6fc09876ad 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. 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 @@ -76,12 +76,13 @@ end_per_suite(_Config) -> crypto:stop(). %%-------------------------------------------------------------------- -init_per_group(openssh, _Config) -> +init_per_group(openssh, Config) -> case gen_tcp:connect("localhost", 22, []) of {error,econnrefused} -> {skip,"No openssh deamon"}; {ok, Socket} -> - gen_tcp:close(Socket) + gen_tcp:close(Socket), + ssh_test_lib:openssh_sanity_check(Config) end; init_per_group(_, Config) -> Config. @@ -93,7 +94,7 @@ end_per_group(_, Config) -> init_per_testcase(_TestCase, Config) -> %% To make sure we start clean as it is not certain that %% end_per_testcase will be run! - ssh:stop(), + end_per_testcase(Config), ssh:start(), Config. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index b8abf5e80e..8ca05746db 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. 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 @@ -358,3 +358,16 @@ do_inet_port(Node) -> {ok, Socket} = rpc:call(Node, gen_tcp, listen, [0, [{reuseaddr, true}]]), {ok, Port} = rpc:call(Node, inet, port, [Socket]), {Port, Socket}. + +openssh_sanity_check(Config) -> + ssh:start(), + case ssh:connect("localhost", 22, []) of + {ok, Pid} -> + ssh:close(Pid), + ssh:stop(), + Config; + Err -> + Str = lists:append(io_lib:format("~p", [Err])), + ssh:stop(), + {skip, Str} + end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index af70eeb46c..a61fd2dd41 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. 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 @@ -66,7 +66,7 @@ init_per_suite(Config) -> {error,econnrefused} -> {skip,"No openssh deamon"}; _ -> - Config + ssh_test_lib:openssh_sanity_check(Config) end; _Else -> {skip,"Could not start crypto!"} @@ -545,6 +545,7 @@ receive_hej() -> receive_logout() -> receive <<"logout">> -> + extra_logout(), receive <<"Connection closed">> -> ok @@ -564,6 +565,14 @@ receive_normal_exit(Shell) -> ct:fail({unexpected_msg, Other}) end. +extra_logout() -> + receive + <<"logout">> -> + ok + after 500 -> + ok + end. + %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- %% Check if we have a "newer" ssh client that supports these test cases diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index b2b85a717f..cef9992f1b 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.2.2 +SSH_VSN = 4.0 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index cfbf98f6e3..143756bd39 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml -XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache.xml ssl_session_cache_api.xml +XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache_api.xml ssl_session_cache_api.xml XML_REF6_FILES = ssl_app.xml XML_PART_FILES = release_notes.xml usersguide.xml diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index d070cb4019..cdf6870c25 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -37,8 +37,7 @@ <title>SSL</title> <list type="bulleted"> - <item><c>ssl</c> requires the <c>crypto</c> and <c>public_key</c> - applications.</item> + <item>For application dependencies see <seealso marker="ssl_app"> ssl(6)</seealso> </item> <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0, TLS-1.1, and TLS-1.2.</item> <item>For security reasons SSL-2.0 is not supported.</item> @@ -46,7 +45,7 @@ but can be configured.</item> <item>Ephemeral Diffie-Hellman cipher suites are supported, but not Diffie Hellman Certificates cipher suites.</item> - <item>Elliptic Curve cipher suites are supported if the <c>crypto</c> + <item>Elliptic Curve cipher suites are supported if the Crypto application supports it and named curves are used. </item> <item>Export cipher suites are not supported as the @@ -64,7 +63,7 @@ <section> <title>DATA TYPES</title> - <p>The following data types are used in the functions for <c>ssl</c>:</p> + <p>The following data types are used in the functions for SSL:</p> <taglist> @@ -82,9 +81,9 @@ <p>For valid options, see the <seealso marker="kernel:inet">inet(3)</seealso> and <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> manual pages - in <c>kernel</c>.</p></item> + in Kernel.</p></item> - <tag><c>ssloption()</c></tag> + <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> @@ -262,7 +261,7 @@ atom()}} | </code> <p>The verification fun is called during the X509-path - validation when an error or an extension unknown to the <c>ssl</c> + validation when an error or an extension unknown to the SSL application is encountered. It is also called when a certificate is considered valid by the path validation to allow access to each certificate in the path to the user @@ -339,7 +338,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <tag><c>{crl_check, boolean() | peer | best_effort }</c></tag> <item> Perform CRL (Certificate Revocation List) verification - <seealso marker="public_key:public_key#pkix_crl_validate-3"> + <seealso marker="public_key:public_key#pkix_crls_validate-3"> (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation <seealso marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3) @@ -376,14 +375,15 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <tag><c>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | unknown_ca }</c></tag> <item><p>Claim an intermediate CA in the chain as trusted. TLS then - performs <c>public_key:pkix_path_validation/3</c> + performs <seealso + marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> with the selected CA as trusted anchor and the rest of the chain.</p></item> <tag><c>{versions, [protocol()]}</c></tag> <item><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option <c>protocol_version</c>. If the environment option is not set, it defaults - to all versions, except SSL-3.0, supported by the <c>ssl</c> application. + to all versions, except SSL-3.0, supported by the SSL application. See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item> <tag><c>{hibernate_after, integer()|undefined}</c></tag> @@ -1000,21 +1000,21 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> - <fsummary>Starts the <c>ssl</c>application.</fsummary> + <fsummary>Starts the SSL application.</fsummary> <type> <v>Type = permanent | transient | temporary</v> </type> <desc> - <p>Starts the <c>ssl</c> application. Default type + <p>Starts the SSL application. Default type is <c>temporary</c>.</p> </desc> </func> <func> <name>stop() -> ok </name> - <fsummary>Stops the <c>ssl</c> application.</fsummary> + <fsummary>Stops the SSL application.</fsummary> <desc> - <p>Stops the <c>ssl</c> application.</p> + <p>Stops the SSL application.</p> </desc> </func> @@ -1056,16 +1056,16 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>versions() -> [versions_info()]</name> <fsummary>Returns version information relevant for the - <c>ssl</c> application.</fsummary> + SSL application.</fsummary> <type> <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol()] </v> </type> <desc> - <p>Returns version information relevant for the <c>ssl</c> + <p>Returns version information relevant for the SSL application.</p> <taglist> <tag><c>app_vsn</c></tag> - <item>The application version of the <c>ssl</c> application.</item> + <item>The application version of the SSL application.</item> <tag><c>supported</c></tag> <item>TLS/SSL versions supported by default. @@ -1078,8 +1078,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </seealso>.</item> <tag><c>available</c></tag> - <item>All TLS/SSL versions supported by the <c>ssl</c> application. - TLS 1.2 requires sufficient support from the <c>crypto</c> + <item>All TLS/SSL versions supported by the SSL application. + TLS 1.2 requires sufficient support from the Crypto application.</item> </taglist> </desc> @@ -1095,4 +1095,3 @@ fun(srp, Username :: string(), UserState :: term()) -> </section> </erlref> - diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 43c69ba377..f17f5cb9fe 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -35,21 +35,21 @@ <description></description> <section> <title>DEPENDENCIES</title> - <p>The <c>ssl</c> application uses the <c>public_key</c> and - <c>crypto</c> application to handle public keys and encryption, hence - these applications must be loaded for the <c>ssl</c> application to work. + <p>The SSL application uses the <c>public_key</c> and + Crypto application to handle public keys and encryption, hence + these applications must be loaded for the SSL application to work. In an embedded environment this means they must be started with - <c>application:start/[1,2]</c> before the <c>ssl</c> application is + <c>application:start/[1,2]</c> before the SSL application is started.</p> </section> <section> <title>CONFIGURATION</title> <p>The application environment configuration parameters in this section - are defined for the <c>ssl</c> application. For more information + are defined for the SSL application. For more information about configuration parameters, see the <seealso marker="kernel:application">application(3)</seealso> - manual page in <c>kernel</c>.</p> + manual page in Kernel.</p> <p>The environment parameters can be set on the command line, for example:</p> @@ -60,7 +60,7 @@ <tag><c><![CDATA[protocol_version = <seealso marker="kernel:error_logger">ssl:protocol()</seealso> <optional>]]></c>.</tag> <item><p>Protocol supported by started clients and servers. If this option is not set, it defaults to all - protocols currently supported by the <c>ssl</c> application. + protocols currently supported by the SSL application. This option can be overridden by the version option to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item> @@ -91,7 +91,7 @@ <section> <title>ERROR LOGGER AND EVENT HANDLERS</title> - <p>The <c>ssl</c> applications uses the default <seealso marker="kernel:error_logger">OTP error logger</seealso> to log unexpected errors and TLS alerts. The logging of TLS alerts may be turned off with the <c>log_alert</c> option. </p> + <p>The SSL application uses the default <seealso marker="kernel:error_logger">OTP error logger</seealso> to log unexpected errors and TLS alerts. The logging of TLS alerts may be turned off with the <c>log_alert</c> option. </p> </section> <section> diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml index 62bf2ea7b7..83b03375b1 100644 --- a/lib/ssl/doc/src/ssl_crl_cache.xml +++ b/lib/ssl/doc/src/ssl_crl_cache.xml @@ -29,7 +29,7 @@ <p> Implements an internal CRL (Certificate Revocation List) cache. In addition to implementing the <seealso - marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso> behaviour + marker="ssl_crl_cache_api"> ssl_crl_cache_api</seealso> behaviour the following functions are available. </p> </description> @@ -44,7 +44,7 @@ <v> Reason = term()</v> </type> <desc> - Delete CRLs from the ssl applications local cache. + <p>Delete CRLs from the ssl applications local cache. </p> </desc> </func> <func> @@ -58,7 +58,7 @@ <v> Reason = term()</v> </type> <desc> - Insert CRLs into the ssl applications local cache. + <p>Insert CRLs into the ssl applications local cache. </p> </desc> </func> </funcs> diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index 557b7814b8..1d9353a2cc 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -70,7 +70,7 @@ </type> <desc> <p> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to - <seealso marker="public_key#pkix_path_validation-3">public_key:pkix_crls_validate/3 </seealso> </p> + <seealso marker="public_key:public_key#pkix_crls_validate-3">public_key:pkix_crls_validate/3 </seealso> </p> </desc> </func> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index c9f7b1b27f..effb304938 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -38,11 +38,11 @@ connection-based protocol as bearer. However, a module that implements the protocol-specific parts of the connection setup is needed. The default distribution module is <c>inet_tcp_dist</c> - in the <c>kernel</c> application. When starting an + in the Kernel application. When starting an Erlang node distributed, <c>net_kernel</c> uses this module to set up listen ports and connections.</p> - <p>In the <c>ssl</c> application, an exra distribution + <p>In the SSL application, an exra distribution module, <c>inet_tls_dist</c>, can be used as an alternative. All distribution connections will use SSL and all participating Erlang nodes in a distributed system must use @@ -57,7 +57,7 @@ <list type="bulleted"> <item><em>Step 1:</em> Build boot scripts including the - <c>ssl</c> application.</item> + SSL application.</item> <item><em>Step 2:</em> Specify the distribution module for <c>net_kernel</c>.</item> <item><em>Step 3:</em> Specify the security options and other @@ -74,8 +74,8 @@ see the <c>sasl</c> documentation. This is only an example of what can be done.</p> - <p>The simplest boot script possible includes only the <c>kernel</c> - and <c>stdlib</c> applications. Such a script is located in the + <p>The simplest boot script possible includes only the Kernel + and STDLIB applications. Such a script is located in the <c>bin</c> directory of the Erlang distribution. The source for the script is found under the Erlang installation top directory under <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>.</p> @@ -84,12 +84,12 @@ <list type="bulleted"> <item><p>Copy that script to another location (and preferably another name).</p></item> - <item><p>Add the applications <c>crypto</c>, <c>public_key</c>, and - <c>ssl</c> with their current version numbers after the - <c>stdlib</c>application.</p></item> + <item><p>Add the applications Crypto, Public Key, and + SSL with their current version numbers after the + STDLIB application.</p></item> </list> - <p>The following shows an example <c>.rel</c> file with <c>ssl</c> + <p>The following shows an example <c>.rel</c> file with SSL added:</p> <code type="none"> {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, @@ -132,27 +132,27 @@ Eshell V5.0 (abort with ^G) 1> whereis(ssl_manager). <0.41.0> ]]></code> - <p>The <c>whereis</c> function-call verifies that the <c>ssl</c> + <p>The <c>whereis</c> function-call verifies that the SSL application is started.</p> <p>As an alternative to building a bootscript, you can explicitly - add the path to the <c>ssl</c> <c>ebin</c> directory on the command + add the path to the SSL <c>ebin</c> directory on the command line. This is done with command-line option <c>-pa</c>. This - works as the <c>ssl</c> application does not need to be started for the - distribution to come up, as a clone of the <c>ssl</c> application is - hooked into the <c>kernel</c> application. So, as long as the - <c>ssl</c> application code can be reached, the distribution starts. + works as the SSL application does not need to be started for the + distribution to come up, as a clone of the SSL application is + hooked into the Kernel application. So, as long as the + SSL application code can be reached, the distribution starts. The <c>-pa</c> method is only recommended for testing purposes.</p> - <note><p>The clone of the <c>ssl</c> application must + <note><p>The clone of the SSL application must enable the use of the SSL code in such an early bootstage as needed to set up the distribution. However, this makes it - impossible to soft upgrade the <c>ssl</c> application.</p></note> + impossible to soft upgrade the SSL application.</p></note> </section> <section> <title>Specifying Distribution Module for net_kernel</title> - <p>The distribution module for <c>ssl</c> is named <c>inet_tls_dist</c> + <p>The distribution module for SSL is named <c>inet_tls_dist</c> and is specified on the command line with option <c>-proto_dist</c>. The argument to <c>-proto_dist</c> is to be the module name without suffix <c>_dist</c>. So, this distribution @@ -172,7 +172,7 @@ Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> <p>However, a node started in this way refuses to talk - to other nodes, as no <c>ssl</c> parameters are supplied + to other nodes, as no SSL parameters are supplied (see the next section).</p> </section> diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index 20f53c98e1..cc49515066 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -32,19 +32,19 @@ <file>ssl_protocol.xml</file> </header> - <p>The Erlang <c>ssl</c> application implements the SSL/TLS protocol + <p>The Erlang SSL application implements the SSL/TLS protocol for the currently supported versions, see the <seealso marker="ssl">ssl(3)</seealso> manual page. </p> - <p>By default <c>ssl</c> is run over the TCP/IP protocol even + <p>By default SSL/TLS is run over the TCP/IP protocol even though you can plug in any other reliable transport protocol with the same Application Programming Interface (API) as the - <c>gen_tcp</c> module in <c>kernel</c>.</p> + <c>gen_tcp</c> module in Kernel.</p> <p>If a client and a server wants to use an upgrade mechanism, such as defined by RFC 2817, to upgrade a regular TCP/IP connection to an SSL - connection, this is supported by the Erlang <c>ssl</c> API. This can be + connection, this is supported by the Erlang SSL application API. This can be useful for, for example, supporting HTTP and HTTPS on the same port and implementing virtual hosting. </p> @@ -143,7 +143,7 @@ connections. Sessions are used to avoid the expensive negotiation of new security parameters for each connection."</p> - <p>Session data is by default kept by the <c>ssl</c> application in a + <p>Session data is by default kept by the SSL application in a memory storage, hence session data is lost at application restart or takeover. Users can define their own callback module to handle session data storage if persistent data storage is diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index 9cd16c5f58..c89d3874a1 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -108,8 +108,8 @@ API functions. Is called by the cache handling processes <c>init</c> function, hence putting the same requirements on it as a normal process <c>init</c> function. This function is - called twice when starting the <c>ssl</c> application, once with - the role client and once with the role server, as the <c>ssl</c> + called twice when starting the SSL application, once with + the role client and once with the role server, as the SSL application must be prepared to take on both roles. </p> </desc> diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index 01b7970fb6..dbbc1aa9d3 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -32,10 +32,10 @@ <file>using_ssl.xml</file> </header> <p>To see relevant version information for ssl, call - <seealso marker="ssl:versions-0"><c>ssl:versions/0</c></seealso> + <seealso marker="ssl:ssl#versions-0"><c>ssl:versions/0</c></seealso> .</p> - <p>To see all supported cipher suites, call <seealso marker="ssl:cipher_suites-1"><c>ssl:cipher_suites(all)</c> </seealso>. + <p>To see all supported cipher suites, call <seealso marker="ssl:ssl#cipher_suites-1"><c>ssl:cipher_suites(all)</c> </seealso>. The available cipher suites for a connection depend on your certificate. Specific cipher suites that you want your connection to use can also be specified. Default is to use the strongest available.</p> diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index f5d8b2072a..a4a2ed9931 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. 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 @@ -48,6 +48,7 @@ XML_REF3_FILES = \ digraph.xml \ digraph_utils.xml \ epp.xml \ + erl_anno.xml \ erl_eval.xml \ erl_expand_records.xml \ erl_id_trans.xml \ @@ -81,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/erl_anno.xml b/lib/stdlib/doc/src/erl_anno.xml new file mode 100644 index 0000000000..281feacdc4 --- /dev/null +++ b/lib/stdlib/doc/src/erl_anno.xml @@ -0,0 +1,308 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2015</year> + <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 on line 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>erl_anno</title> + <prepared>Hans Bolinder</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>2015-02-26</date> + <rev>A</rev> + <file>erl_anno.xml</file> + </header> + <module>erl_anno</module> + + <modulesummary> + Abstract Datatype for the Annotations of the Erlang Compiler + </modulesummary> + + <description> + <p>This module implements an abstract type that is used by the + Erlang Compiler and its helper modules for holding data such as + column, line number, and text. The data type is a collection of + <marker id="annotations"><em>annotations</em></marker> as + described in the following.</p> + <p>The Erlang Token Scanner returns tokens with a subset of + the following annotations, depending on the options:</p> + <taglist> + <tag><c>column</c></tag> + <item><p>The column where the token begins.</p></item> + <tag><c>location</c></tag> + <item><p>The line and column where the token begins, or + just the line if the column unknown.</p> + </item> + <tag><c>text</c></tag> + <item><p>The token's text.</p></item> + </taglist> + <p>From the above the following annotation is derived:</p> + <taglist> + <tag><c>line</c></tag> + <item><p>The line where the token begins.</p></item> + </taglist> + <p>Furthermore, the following annotations are supported by + this module, and used by various modules:</p> + <taglist> + <tag><c>file</c></tag> + <item><p>A filename.</p></item> + <tag><c>generated</c></tag> + <item><p>A Boolean indicating if the abstract code is + compiler generated. The Erlang Compiler does not emit warnings + for such code.</p> + </item> + <tag><c>record</c></tag> + <item><p>A Boolean indicating if the origin of the abstract + code is a record. Used by Dialyzer to assign types to tuple + elements.</p> + </item> + </taglist> + <p>The functions + <seealso marker="erl_scan#column/1">column()</seealso>, + <seealso marker="erl_scan#end_location/1">end_location()</seealso>, + <seealso marker="erl_scan#line/1">line()</seealso>, + <seealso marker="erl_scan#location/1">location()</seealso>, and + <seealso marker="erl_scan#text/1">text()</seealso> + in the <c>erl_scan</c> module can be used for inspecting + annotations in tokens.</p> + <p>The functions + <seealso marker="erl_parse#map_anno/2">map_anno()</seealso>, + <seealso marker="erl_parse#fold_anno/3">fold_anno()</seealso>, + <seealso marker="erl_parse#mapfold_anno/3">mapfold_anno()</seealso>, + <seealso marker="erl_parse#new_anno/1">new_anno()</seealso>, + <seealso marker="erl_parse#anno_from_term/1"> + anno_from_term()</seealso>, and + <seealso marker="erl_parse#anno_to_term/1"> + anno_to_term()</seealso> in the <c>erl_parse</c> module can be + used for manipulating annotations in abstract code. + </p> + </description> + + <datatypes> + <datatype> + <name><marker id="type-anno">anno()</marker></name> + <desc><p>A collection of annotations.</p> + </desc> + </datatype> + <datatype> + <name name="anno_term"></name> + <desc> + <p>The term representing a collection of annotations. It is + either a <c>location()</c> or a list of key-value pairs.</p> + </desc> + </datatype> + <datatype> + <name name="column"></name> + </datatype> + <datatype> + <name name="line"></name> + <desc> + <p>To be changed to a non-negative integer in Erlang/OTP 19.0.</p> + </desc> + </datatype> + <datatype> + <name name="location"></name> + </datatype> + <datatype> + <name name="text"></name> + </datatype> + </datatypes> + + <funcs> + <func> + <name name="column" arity="1"/> + <type name="column"></type> + <fsummary>Return the column</fsummary> + <desc> + <p>Returns the column of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="end_location" arity="1"/> + <type name="location"></type> + <fsummary>Return the end location of the text</fsummary> + <desc> + <p>Returns the end location of the text of the + annotations <anno>Anno</anno>. If there is no text, + <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="file" arity="1"/> + <type name="filename"></type> + <fsummary>Return the filename</fsummary> + <desc> + <p>Returns the filename of the annotations <anno>Anno</anno>. + If there is no filename, <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="from_term" arity="1"/> + <fsummary>Return annotations given a term</fsummary> + <desc> + <p>Returns annotations with the representation <anno>Term</anno>. + </p> + <!-- + <p>Although it is possible to create new annotations by calling + <c>from_term/1</c>, the intention is that one should not do + so - the proper way to create annotations is to call + <c>new/1</c> and then modify the annotations + by calling the <c>set_*</c> functions.</p> + --> + <p>See also <seealso marker="#to_term/1">to_term()</seealso>. + </p> + </desc> + </func> + <func> + <name name="generated" arity="1"/> + <type name="generated"></type> + <fsummary>Return the generated Boolean</fsummary> + <desc> + <p>Returns <c>true</c> if the annotations <anno>Anno</anno> + has been marked as generated. The default is to return + <c>false</c>. + </p> + </desc> + </func> + <func> + <name name="is_anno" arity="1"/> + <fsummary>Test for a collection of annotations</fsummary> + <desc> + <p>Returns <c>true</c> if <anno>Term</anno> is a collection of + annotations, <c>false</c> otherwise.</p> + </desc> + </func> + <func> + <name name="line" arity="1"/> + <type name="line"></type> + <fsummary>Return the line</fsummary> + <desc> + <p>Returns the line of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="location" arity="1"/> + <type name="location"></type> + <fsummary>Return the location</fsummary> + <desc> + <p>Returns the location of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="new" arity="1"/> + <type name="location"></type> + <fsummary>Create a new collection of annotations</fsummary> + <desc> + <p>Creates a new collection of annotations given a location.</p> + </desc> + </func> + <func> + <name name="set_file" arity="2"/> + <type name="filename"></type> + <fsummary>Modify the filename</fsummary> + <desc> + <p>Modifies the filename of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_generated" arity="2"/> + <type name="generated"></type> + <fsummary>Modify the generated marker</fsummary> + <desc> + <p>Modifies the generated marker of the annotations + <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_line" arity="2"/> + <type name="line"></type> + <fsummary>Modify the line</fsummary> + <desc> + <p>Modifies the line of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_location" arity="2"/> + <type name="location"></type> + <fsummary>Modify the location</fsummary> + <desc> + <p>Modifies the location of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_record" arity="2"/> + <type name="record"></type> + <fsummary>Modify the record marker</fsummary> + <desc> + <p>Modifies the record marker of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_text" arity="2"/> + <type name="text"></type> + <fsummary>Modify the text</fsummary> + <desc> + <p>Modifies the text of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="text" arity="1"/> + <type name="text"></type> + <fsummary>Return the text</fsummary> + <desc> + <p>Returns the text of the annotations <anno>Anno</anno>. + If there is no text, <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="to_term" arity="1"/> + <fsummary>Return the term representing a collection of + annotations</fsummary> + <desc> + <p>Returns the term representing the annotations <anno>Anno</anno>. + </p> + <p>See also <seealso marker="#from_term/1">from_term()</seealso>. + </p> + </desc> + </func> + </funcs> + <section> + <title>See Also</title> + <p><seealso marker="erl_scan">erl_scan(3)</seealso>, + <seealso marker="erl_parse">erl_parse(3)</seealso> + </p> + </section> +</erlref> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index cf0bff48cd..b97d06e919 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2014</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -192,6 +192,97 @@ considered a string.</p> </desc> </func> + <func> + <name name="map_anno" arity="2"/> + <fsummary> + Map a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Modifies the abstract form <anno>Abstr</anno> by applying + <anno>Fun</anno> on every collection of annotations of the + abstract form. The abstract form is traversed in a + depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="fold_anno" arity="3"/> + <fsummary> + Fold a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Updates an accumulator by applying <anno>Fun</anno> on + every collection of annotations of the abstract form + <anno>Abstr</anno>. The first call to <anno>Fun</anno> has + <anno>AccIn</anno> as argument, and the returned accumulator + <anno>AccOut</anno> is passed to the next call, and so on. + The final value of the accumulator is returned. The abstract + form is traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="mapfold_anno" arity="3"/> + <fsummary> + Map and fold a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Modifies the abstract form <anno>Abstr</anno> by applying + <anno>Fun</anno> on every collection of annotations of the + abstract form, while at the same time updating an + accumulator. The first call to <anno>Fun</anno> has + <anno>AccIn</anno> as second argument, and the returned + accumulator <anno>AccOut</anno> is passed to the next call, + and so on. The modified abstract form as well as the the + final value of the accumulator is returned. The abstract + form is traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="new_anno" arity="1"/> + <fsummary> + Create new annotations + </fsummary> + <desc> + <p>Creates an abstract form from a term which has the same + structure as an abstract form, but <seealso + marker="erl_anno#type-location">locations</seealso> where the + abstract form has annotations. For each location, <seealso + marker="erl_anno#new/1"><c>erl_anno:new/1</c></seealso> is + called, and the annotations replace the location. + </p> + </desc> + </func> + <func> + <name name="anno_from_term" arity="1"/> + <fsummary> + Return annotations as terms + </fsummary> + <desc> + <p>Assumes that <anno>Term</anno> is a term with the same + structure as an abstract form, but with terms, T say, on + those places where an abstract form has annotations. Returns + an abstract form where every term T has been replaced by the + value returned by calling <c>erl_anno:from_term(T)</c>. The + term <anno>Term</anno> is traversed in a depth-first, + left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="anno_to_term" arity="1"/> + <fsummary> + Return the representation of annotations + </fsummary> + <desc> + <p>Returns a term where every collection of annotations Anno of + <anno>Abstr</anno> has been replaced by the term returned by + calling <c>erl_anno:to_term(Anno)</c>. The abstract form is + traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> </funcs> <section> @@ -211,8 +302,9 @@ <section> <title>See Also</title> <p><seealso marker="io">io(3)</seealso>, - <seealso marker="erl_scan">erl_scan(3)</seealso>, - ERTS User's Guide</p> + <seealso marker="erl_anno">erl_anno(3)</seealso>, + <seealso marker="erl_scan">erl_scan(3)</seealso>, + <seealso marker="erts:absform">ERTS User's Guide</seealso></p> </section> </erlref> diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 855c8fc195..8f9c1db25b 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -120,7 +120,7 @@ <c>string(<anno>String</anno>, <anno>StartLocation</anno>, [])</c>.</p> <p><c><anno>StartLocation</anno></c> indicates the initial location - when scanning starts. If <c><anno>StartLocation</anno></c> is a line + when scanning starts. If <c><anno>StartLocation</anno></c> is a line, <c>attributes()</c> as well as <c><anno>EndLocation</anno></c> and <c><anno>ErrorLocation</anno></c> will be lines. If <c><anno>StartLocation</anno></c> is a pair of a line and a column @@ -132,8 +132,12 @@ line where the token begins, as well as the text of the token (if the <c>text</c> option is given), all of which can be accessed by calling <seealso - marker="#token_info/1">token_info/1,2</seealso> or <seealso - marker="#attributes_info/1">attributes_info/1,2</seealso>.</p> + marker="#token_info/1">token_info/1,2</seealso>, <seealso + marker="#attributes_info/1">attributes_info/1,2</seealso>, + <seealso marker="#column/1">column/1</seealso>, + <seealso marker="#line/1">line/1</seealso>, + <seealso marker="#location/1">location/1</seealso>, and + <seealso marker="#text/1">text/1</seealso>.</p> <p>A <em>token</em> is a tuple containing information about syntactic category, the token attributes, and the actual terminal symbol. For punctuation characters (e.g. <c>;</c>, @@ -237,6 +241,70 @@ </desc> </func> <func> + <name name="category" arity="1"/> + <fsummary>Return the category</fsummary> + <desc> + <p>Returns the category of <c><anno>Token</anno></c>. + </p> + </desc> + </func> + <func> + <name name="symbol" arity="1"/> + <fsummary>Return the symbol</fsummary> + <desc> + <p>Returns the symbol of <c><anno>Token</anno></c>. + </p> + </desc> + </func> + <func> + <name name="column" arity="1"/> + <fsummary>Return the column</fsummary> + <desc> + <p>Returns the column of <c><anno>Token</anno></c>'s + collection of annotations. + </p> + </desc> + </func> + <func> + <name name="end_location" arity="1"/> + <fsummary>Return the end location of the text</fsummary> + <desc> + <p>Returns the end location of the text of + <c><anno>Token</anno></c>'s collection of annotations. If + there is no text, + <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="line" arity="1"/> + <fsummary>Return the line</fsummary> + <desc> + <p>Returns the line of <c><anno>Token</anno></c>'s collection + of annotations. + </p> + </desc> + </func> + <func> + <name name="location" arity="1"/> + <fsummary>Return the location</fsummary> + <desc> + <p>Returns the location of <c><anno>Token</anno></c>'s + collection of annotations. + </p> + </desc> + </func> + <func> + <name name="text" arity="1"/> + <fsummary>Return the text</fsummary> + <desc> + <p>Returns the text of <c><anno>Token</anno></c>'s collection + of annotations. If there is no text, <c>undefined</c> is + returned. + </p> + </desc> + </func> + <func> <name name="token_info" arity="1"/> <fsummary>Return information about a token</fsummary> <desc> @@ -417,6 +485,7 @@ Module:format_error(ErrorDescriptor)</code> <section> <title>See Also</title> <p><seealso marker="io">io(3)</seealso>, - <seealso marker="erl_parse">erl_parse(3)</seealso></p> + <seealso marker="erl_anno">erl_anno(3)</seealso>, + <seealso marker="erl_parse">erl_parse(3)</seealso></p> </section> </erlref> 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..e46068230a 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -339,7 +339,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 ea4009dc3e..eee4a68ca1 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -45,6 +45,7 @@ <xi:include href="digraph.xml"/> <xi:include href="digraph_utils.xml"/> <xi:include href="epp.xml"/> + <xi:include href="erl_anno.xml"/> <xi:include href="erl_eval.xml"/> <xi:include href="erl_expand_records.xml"/> <xi:include href="erl_id_trans.xml"/> @@ -78,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 fd77b52da6..0418bf7b22 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -11,6 +11,7 @@ <xi:include href="../specs/specs_digraph.xml"/> <xi:include href="../specs/specs_digraph_utils.xml"/> <xi:include href="../specs/specs_epp.xml"/> + <xi:include href="../specs/specs_erl_anno.xml"/> <xi:include href="../specs/specs_erl_eval.xml"/> <xi:include href="../specs/specs_erl_expand_records.xml"/> <xi:include href="../specs/specs_erl_id_trans.xml"/> @@ -44,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 1b3744b6fb..55bda60da5 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-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 @@ -58,6 +58,7 @@ MODULES= \ edlin \ edlin_expand \ epp \ + erl_anno \ erl_bits \ erl_compile \ erl_eval \ @@ -104,6 +105,7 @@ MODULES= \ qlc \ qlc_pt \ queue \ + rand \ random \ sets \ shell \ @@ -168,6 +170,7 @@ docs: # specifications. primary_bootstrap_compiler: \ $(BOOTSTRAP_COMPILER)/ebin/epp.beam \ + $(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \ diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 1a7b7d5a5e..4a6b489204 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. 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 @@ -652,7 +652,13 @@ chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) -> {'EXIT', _} -> error({invalid_chunk, File, chunk_name_to_id(Id, File)}); Term -> - {AtomTable, {Id, Term}} + try + {AtomTable, {Id, anno_from_term(Term)}} + catch + _:_ -> + error({invalid_chunk, File, + chunk_name_to_id(Id, File)}) + end end end; chunk_to_data(atoms=Id, _Chunk, _File, Cs, AtomTable0, _Mod) -> @@ -878,7 +884,22 @@ decrypt_abst(Type, Module, File, Id, AtomTable, Bin) -> decrypt_abst_1({Type,Key,IVec,_BlockSize}, Bin) -> ok = start_crypto(), NewBin = crypto:block_decrypt(Type, Key, IVec, Bin), - binary_to_term(NewBin). + Term = binary_to_term(NewBin), + anno_from_term(Term). + +anno_from_term({raw_abstract_v1, Forms}) -> + {raw_abstract_v1, anno_from_forms(Forms)}; +anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> + try {Tag, anno_from_forms(Forms)} + catch + _:_ -> + {Tag, Forms} + end; +anno_from_term(T) -> + T. + +anno_from_forms(Forms) -> + [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> case crypto:start() of diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index b3bc5f6d92..362669545e 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -21,7 +21,7 @@ %% A simple Emacs-like line editor. %% About Latin-1 characters: see the beginning of erl_scan.erl. --export([init/0,start/1,start/2,edit_line/2,prefix_arg/1]). +-export([init/0,init/1,start/1,start/2,edit_line/2,prefix_arg/1]). -export([erase_line/1,erase_inp/1,redraw_line/1]). -export([length_before/1,length_after/1,prompt/1]). -export([current_line/1, current_chars/1]). @@ -44,6 +44,20 @@ init() -> put(kill_buffer, []). +init(Pid) -> + %% copy the kill_buffer from the process Pid + CopiedKillBuf = + case erlang:process_info(Pid, dictionary) of + {dictionary,Dict} -> + case proplists:get_value(kill_buffer, Dict) of + undefined -> []; + Buf -> Buf + end; + undefined -> + [] + end, + put(kill_buffer, CopiedKillBuf). + %% start(Prompt) %% edit(Characters, Continuation) %% Return diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 5f8637c118..7866b5f792 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -158,7 +158,7 @@ scan_erl_form(Epp) -> {'ok', AbsForm} | {'eof', Line} | {error, ErrorInfo} when Epp :: epp_handle(), AbsForm :: erl_parse:abstract_form(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). parse_erl_form(Epp) -> @@ -220,7 +220,7 @@ format_error(E) -> file:format_error(E). IncludePath :: [DirectoryName :: file:name()], Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, PredefMacros :: macros(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), OpenError :: file:posix() | badarg | system_limit. @@ -235,7 +235,7 @@ parse_file(Ifile, Path, Predefs) -> {'default_encoding', DefEncoding :: source_encoding()} | 'extra'], Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), Extra :: [{'encoding', source_encoding() | 'none'}], OpenError :: file:posix() | badarg | system_limit. @@ -257,7 +257,7 @@ parse_file(Ifile, Options) -> -spec parse_file(Epp) -> [Form] when Epp :: epp_handle(), Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). parse_file(Epp) -> @@ -280,7 +280,7 @@ parse_file(Epp) -> {error,E} -> [{error,E}|parse_file(Epp)]; {eof,Location} -> - [{eof,Location}] + [{eof,erl_anno:new(Location)}] end. -spec default_encoding() -> source_encoding(). @@ -547,7 +547,8 @@ init_server(Pid, Name, Options, St0) -> path=Path, macs=Ms1, default_encoding=DefEncoding}, From = wait_request(St), - enter_file_reply(From, Name, AtLocation, AtLocation), + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, Name, Anno, AtLocation, code), wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) @@ -559,15 +560,16 @@ init_server(Pid, Name, Options, St0) -> predef_macros(File) -> Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), dict:from_list([ - {{atom,'FILE'}, {none,[{string,1,File}]}}, - {{atom,'LINE'}, {none,[{integer,1,1}]}}, + {{atom,'FILE'}, {none,[{string,Anno,File}]}}, + {{atom,'LINE'}, {none,[{integer,Anno,1}]}}, {{atom,'MODULE'}, undefined}, {{atom,'MODULE_STRING'}, undefined}, {{atom,'BASE_MODULE'}, undefined}, {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,1,Machine}]}}, - {{atom,Machine}, {none,[{atom,1,true}]}} + {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}}, + {{atom,Machine}, {none,[{atom,Anno,true}]}} ]). %% user_predef(PreDefMacros, Macros) -> @@ -595,8 +597,9 @@ user_predef([M|Pdm], Ms) when is_atom(M) -> {ok,_Def} -> %% Predefined macros {error,{redefine_predef,M}}; error -> + A = line1(), user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,1,true}]}}], Ms)) + dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms)) end; user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. @@ -645,7 +648,7 @@ wait_req_skip(St, Sis) -> enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); enter_file(NewName, Inc, From, St) -> case file:path_open(St#epp.path, NewName, [read]) of @@ -653,7 +656,7 @@ enter_file(NewName, Inc, From, St) -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E} -> - epp_reply(From, {error,{abs_loc(Inc),epp,{include,file,NewName}}}), + epp_reply(From, {error,{loc(Inc),epp,{include,file,NewName}}}), wait_req_scan(St) end. @@ -661,9 +664,9 @@ enter_file(NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St0, AtLocation) -> - Loc = start_loc(AtLocation), - enter_file_reply(From, Pname, Loc, AtLocation), - Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St0#epp.macs), + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, Pname, Anno, AtLocation, code), + Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs), %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note @@ -673,16 +676,20 @@ enter_file2(NewF, Pname, From, St0, AtLocation) -> Path = [filename:dirname(Pname) | tl(St0#epp.path)], DefEncoding = St0#epp.default_encoding, _ = set_encoding(NewF, DefEncoding), - #epp{file=NewF,location=Loc,name=Pname,name2=Pname,delta=0, + #epp{file=NewF,location=AtLocation,name=Pname,name2=Pname,delta=0, sstk=[St0|St0#epp.sstk],path=Path,macs=Ms, default_encoding=DefEncoding}. -enter_file_reply(From, Name, Location, AtLocation) -> - Attr = loc_attr(AtLocation), - Rep = {ok, [{'-',Attr},{atom,Attr,file},{'(',Attr}, - {string,Attr,file_name(Name)},{',',Attr}, - {integer,Attr,get_line(Location)},{')',Location}, - {dot,Attr}]}, +enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> + Anno0 = loc_anno(AtLocation), + Anno = case Where of + code -> Anno0; + generated -> erl_anno:set_generated(true, Anno0) + end, + Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, + {string,Anno,file_name(Name)},{',',Anno}, + {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, + {dot,Anno}]}, epp_reply(From, Rep). %% Flatten filename to a string. Must be a valid filename. @@ -710,18 +717,20 @@ leave_file(From, St) -> #epp{location=OldLoc, delta=Delta, name=OldName, name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), + Anno = erl_anno:new(CurrLoc), Ms = dict:store({atom,'FILE'}, - {none,[{string,CurrLoc,OldName2}]}, + {none,[{string,Anno,OldName2}]}, St#epp.macs), NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, - enter_file_reply(From, OldName, CurrLoc, CurrLoc), + enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of true -> ok; false -> NFrom = wait_request(NextSt), - enter_file_reply(NFrom, OldName2, OldLoc, - neg_line(CurrLoc)) + OldAnno = erl_anno:new(OldLoc), + enter_file_reply(NFrom, OldName2, OldAnno, + CurrLoc, generated) end, wait_req_scan(NextSt); [] -> @@ -818,9 +827,9 @@ scan_extends(_Ts, _As, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',Lc}|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St) when Type =:= atom; Type =:= var -> - case catch macro_expansion(Toks, Lc) of + case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> case dict:find({atom,M}, St#epp.macs) of {ok, Defs} when is_list(Defs) -> @@ -910,10 +919,12 @@ macro_ref([]) -> []; macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref(Rest); -macro_ref([{'?', _}, {atom, Lm, A} | Rest]) -> +macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> + Lm = loc(Atom), Arity = count_args(Rest, Lm, A), [{{atom, A}, Arity} | macro_ref(Rest)]; -macro_ref([{'?', _}, {var, Lm, A} | Rest]) -> +macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> + Lm = loc(Var), Arity = count_args(Rest, Lm, A), [{{atom, A}, Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> @@ -940,7 +951,7 @@ scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, NewName = expand_var(NewName0), enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), + epp_reply(From, {error,{loc(Inc),epp,{bad,include}}}), wait_req_scan(St). %% scan_include_lib(Tokens, IncludeToken, From, EppState) @@ -955,7 +966,7 @@ find_lib_dir(NewName) -> scan_include_lib([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include_lib"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include_lib"}}}), wait_req_scan(St); scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> @@ -974,18 +985,18 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], St, Loc)); {error,_E2} -> epp_reply(From, - {error,{abs_loc(Inc),epp, + {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end; _Error -> - epp_reply(From, {error,{abs_loc(Inc),epp, + epp_reply(From, {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end end; scan_include_lib(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include_lib}}}), + epp_reply(From, {error,{loc(Inc),epp,{bad,include_lib}}}), wait_req_scan(St). %% scan_ifdef(Tokens, IfdefToken, From, EppState) @@ -1088,11 +1099,12 @@ scan_endif(_Toks, Endif, From, St) -> scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, {dot,_Ld}], Tf, From, St) -> - enter_file_reply(From, Name, Ln, neg_line(abs_loc(Tf))), - Ms = dict:store({atom,'FILE'}, {none,[{string,1,Name}]}, St#epp.macs), + Anno = erl_anno:new(Ln), + enter_file_reply(From, Name, Anno, loc(Tf), generated), + Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs), Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), - Delta = abs(get_line(element(2, Tf)))-Ln + St#epp.delta, + Delta = get_line(element(2, Tf))-Ln + St#epp.delta, wait_req_scan(St#epp{name2=Name,location=NewLoc,delta=Delta,macs=Ms}); scan_file(_Toks, Tf, From, St) -> epp_reply(From, {error,{loc(Tf),epp,{bad,file}}}), @@ -1153,7 +1165,7 @@ skip_else(_Else, From, St, Sis) -> skip_toks(From, St, Sis). %% macro_pars(Tokens, ArgStack) -%% macro_expansion(Tokens, Line) +%% macro_expansion(Tokens, Anno) %% Extract the macro parameters and the expansion from a macro definition. macro_pars([{')',_Lp}, {',',Ld}|Ex], Args) -> @@ -1165,11 +1177,12 @@ macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> false = lists:member(Name, Args), macro_pars(Ts, [Name|Args]). -macro_expansion([{')',_Lp},{dot,_Ld}], _L0) -> []; -macro_expansion([{dot,Ld}], _L0) -> throw({error,Ld,missing_parenthesis}); -macro_expansion([T|Ts], _L0) -> - [T|macro_expansion(Ts, element(2, T))]; -macro_expansion([], L0) -> throw({error,L0,premature_end}). +macro_expansion([{')',_Lp},{dot,_Ld}], _Anno0) -> []; +macro_expansion([{dot,_}=Dot], _Anno0) -> + throw({error,loc(Dot),missing_parenthesis}); +macro_expansion([T|Ts], _Anno0) -> + [T|macro_expansion(Ts, T)]; +macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). %% expand_macros(Tokens, Macros) %% expand_macro(Tokens, MacroToken, RestTokens) @@ -1239,17 +1252,17 @@ expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> expand_macros(atom, MacT, M, Toks, Ms); %% Special macros expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> - {line,Line} = erl_scan:token_info(Tok, line), + Line = erl_scan:line(Tok), [{integer,Lm,Line}|expand_macros(Toks, Ms)]; expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> expand_macros(atom, MacT, M, Toks, Ms); %% Illegal macros expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> - T = case erl_scan:token_info(Token, text) of - {text,Text} -> + T = case erl_scan:text(Token) of + Text when is_list(Text) -> Text; undefined -> - {symbol,Symbol} = erl_scan:token_info(Token, symbol), + Symbol = erl_scan:symbol(Token), io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); @@ -1383,7 +1396,7 @@ expand_arg([], Ts, L, Rest, Bs) -> %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. -%% erl_scan:token_info(T, text) is not backward compatible with this. +%% erl_scan:text(T) is not backward compatible with this. %% Note that escaped characters will be replaced by themselves. token_src({dot, _}) -> "."; @@ -1456,36 +1469,29 @@ fname_join(Components) -> filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) -loc_attr(Line) when is_integer(Line) -> - Line; -loc_attr({Line,_Column}) -> - Line. +loc_anno(Line) when is_integer(Line) -> + erl_anno:new(Line); +loc_anno({Line,_Column}) -> + erl_anno:new(Line). loc(Token) -> - {location,Location} = erl_scan:token_info(Token, location), - Location. + erl_scan:location(Token). -abs_loc(Token) -> - loc(setelement(2, Token, abs_line(element(2, Token)))). - -neg_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> -abs(Line) end). - -abs_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> abs(Line) end). - -add_line(L, Offset) -> - erl_scan:set_attribute(line, L, fun(Line) -> Line+Offset end). +add_line(Line, Offset) when is_integer(Line) -> + Line+Offset; +add_line({Line, Column}, Offset) -> + {Line+Offset, Column}. start_loc(Line) when is_integer(Line) -> 1; start_loc({_Line, _Column}) -> - {1,1}. + {1, 1}. -get_line(Line) when is_integer(Line) -> - Line; -get_line({Line,_Column}) -> - Line. +line1() -> + erl_anno:new(1). + +get_line(Anno) -> + erl_anno:line(Anno). %% epp has always output -file attributes when entering and leaving %% included files (-include, -include_lib). Starting with R11B the @@ -1525,14 +1531,15 @@ get_line({Line,_Column}) -> interpret_file_attribute(Forms) -> interpret_file_attr(Forms, 0, []). -interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], +interpret_file_attr([{attribute,Anno,file,{File,Line}}=Form | Forms], Delta, Fs) -> - {line, L} = erl_scan:attributes_info(Loc, line), + L = get_line(Anno), + Generated = erl_anno:generated(Anno), if - L < 0 -> + Generated -> %% -file attribute - interpret_file_attr(Forms, (abs(L) + Delta) - Line, Fs); - true -> + interpret_file_attr(Forms, (L + Delta) - Line, Fs); + not Generated -> %% -include or -include_lib % true = L =:= Line, case Fs of @@ -1543,11 +1550,11 @@ interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], end end; interpret_file_attr([Form0 | Forms], Delta, Fs) -> - F = fun(Attrs) -> - F2 = fun(L) -> abs(L) + Delta end, - erl_scan:set_attribute(line, Attrs, F2) + F = fun(Anno) -> + Line = erl_anno:line(Anno), + erl_anno:set_line(Line + Delta, Anno) end, - Form = erl_lint:modify_line(Form0, F), + Form = erl_parse:map_anno(F, Form0), [Form | interpret_file_attr(Forms, Delta, Fs)]; interpret_file_attr([], _Delta, _Fs) -> []. diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl new file mode 100644 index 0000000000..963b7278a6 --- /dev/null +++ b/lib/stdlib/src/erl_anno.erl @@ -0,0 +1,460 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-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(erl_anno). + +-export([new/1, is_anno/1]). +-export([column/1, end_location/1, file/1, generated/1, + line/1, location/1, record/1, text/1]). +-export([set_file/2, set_generated/2, set_line/2, set_location/2, + set_record/2, set_text/2]). + +%% To be used when necessary to avoid Dialyzer warnings. +-export([to_term/1, from_term/1]). + +-export_type([anno/0, line/0, column/0, location/0, text/0]). + +-export_type([anno_term/0]). + +-define(LN(L), is_integer(L)). +-define(COL(C), (is_integer(C) andalso C >= 1)). + +%% Location. +-define(LCOLUMN(C), ?COL(C)). +-define(LLINE(L), ?LN(L)). + +%% Debug: define DEBUG to make sure that annotations are handled as an +%% opaque type. Note that all abstract code need to be compiled with +%% DEBUG=true. See also ./erl_pp.erl. + +%-define(DEBUG, true). + +-type annotation() :: {'file', filename()} + | {'generated', generated()} + | {'location', location()} + | {'record', record()} + | {'text', string()}. + +-type anno() :: location() | [annotation(), ...]. +-type anno_term() :: term(). + +-type column() :: pos_integer(). +-type generated() :: boolean(). +-type filename() :: file:filename_all(). +-type line() :: integer(). +-type location() :: line() | {line(), column()}. +-type record() :: boolean(). +-type text() :: string(). + +-ifdef(DEBUG). +%% Anything 'false' accepted by the compiler. +-define(ALINE(A), is_reference(A)). +-define(ACOLUMN(A), is_reference(A)). +-else. +-define(ALINE(L), ?LN(L)). +-define(ACOLUMN(C), ?COL(C)). +-endif. + +-spec to_term(Anno) -> anno_term() when + Anno :: anno(). + +-ifdef(DEBUG). +to_term(Anno) -> + simplify(Anno). +-else. +to_term(Anno) -> + Anno. +-endif. + +-spec from_term(Term) -> Anno when + Term :: anno_term(), + Anno :: anno(). + +-ifdef(DEBUG). +from_term(Term) when is_list(Term) -> + Term; +from_term(Term) -> + [{location, Term}]. +-else. +from_term(Term) -> + Term. +-endif. + +-spec new(Location) -> anno() when + Location :: location(). + +new(Line) when ?LLINE(Line) -> + new_location(Line); +new({Line, Column}=Loc) when ?LLINE(Line), ?LCOLUMN(Column) -> + new_location(Loc); +new(Term) -> + erlang:error(badarg, [Term]). + +-ifdef(DEBUG). +new_location(Location) -> + [{location, Location}]. +-else. +new_location(Location) -> + Location. +-endif. + +-spec is_anno(Term) -> boolean() when + Term :: any(). + +is_anno(Line) when ?ALINE(Line) -> + true; +is_anno({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + true; +is_anno(Anno) -> + (Anno =/= [] andalso + is_anno1(Anno) andalso + lists:keymember(location, 1, Anno)). + +is_anno1([{Item, Value}|Anno]) -> + is_anno2(Item, Value) andalso is_anno1(Anno); +is_anno1(A) -> + A =:= []. + +is_anno2(location, Line) when ?LN(Line) -> + true; +is_anno2(location, {Line, Column}) when ?LN(Line), ?COL(Column) -> + true; +is_anno2(generated, true) -> + true; +is_anno2(file, Filename) -> + is_filename(Filename); +is_anno2(record, true) -> + true; +is_anno2(text, Text) -> + is_string(Text); +is_anno2(_, _) -> + false. + +is_filename(T) -> + is_string(T) orelse is_binary(T). + +is_string(T) -> + try lists:all(fun(C) when is_integer(C), C >= 0 -> true end, T) + catch _:_ -> false + end. + +-spec column(Anno) -> column() | 'undefined' when + Anno :: anno(). + +column({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + Column; +column(Line) when ?ALINE(Line) -> + undefined; +column(Anno) -> + case location(Anno) of + {_Line, Column} -> + Column; + _Line -> + undefined + end. + +-spec end_location(Anno) -> location() | 'undefined' when + Anno :: anno(). + +end_location(Anno) -> + case text(Anno) of + undefined -> + undefined; + Text -> + case location(Anno) of + {Line, Column} -> + end_location(Text, Line, Column); + Line -> + end_location(Text, Line) + end + end. + +-spec file(Anno) -> filename() | 'undefined' when + Anno :: anno(). + +file(Line) when ?ALINE(Line) -> + undefined; +file({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +file(Anno) -> + anno_info(Anno, file). + +-spec generated(Anno) -> generated() when + Anno :: anno(). + +generated(Line) when ?ALINE(Line) -> + Line =< 0; +generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + Line =< 0; +generated(Anno) -> + _ = anno_info(Anno, generated, false), + {location, Location} = lists:keyfind(location, 1, Anno), + case Location of + {Line, _Column} -> + Line =< 0; + Line -> + Line =< 0 + end. + +-spec line(Anno) -> line() when + Anno :: anno(). + +line(Anno) -> + case location(Anno) of + {Line, _Column} -> + Line; + Line -> + Line + end. + +-spec location(Anno) -> location() when + Anno :: anno(). + +location(Line) when ?ALINE(Line) -> + abs(Line); +location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + {abs(Line), Column}; +location(Anno) -> + case anno_info(Anno, location) of + Line when Line < 0 -> + -Line; + {Line, Column} when Line < 0 -> + {-Line, Column}; + Location -> + Location + end. + +-spec record(Anno) -> record() when + Anno :: anno(). + +record(Line) when ?ALINE(Line) -> + false; +record({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + false; +record(Anno) -> + anno_info(Anno, record, false). + +-spec text(Anno) -> text() | 'undefined' when + Anno :: anno(). + +text(Line) when ?ALINE(Line) -> + undefined; +text({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +text(Anno) -> + anno_info(Anno, text). + +-spec set_file(File, Anno) -> Anno when + File :: filename(), + Anno :: anno(). + +set_file(File, Anno) -> + set(file, File, Anno). + +-spec set_generated(Generated, Anno) -> Anno when + Generated :: generated(), + Anno :: anno(). + +set_generated(true, Line) when ?ALINE(Line) -> + -abs(Line); +set_generated(false, Line) when ?ALINE(Line) -> + abs(Line); +set_generated(true, {Line, Column}) when ?ALINE(Line), + ?ACOLUMN(Column) -> + {-abs(Line),Column}; +set_generated(false, {Line, Column}) when ?ALINE(Line), + ?ACOLUMN(Column) -> + {abs(Line),Column}; +set_generated(Generated, Anno) -> + _ = set(generated, Generated, Anno), + {location, Location} = lists:keyfind(location, 1, Anno), + NewLocation = + case Location of + {Line, Column} when Generated -> + {-abs(Line), Column}; + {Line, Column} when not Generated -> + {abs(Line), Column}; + Line when Generated -> + -abs(Line); + Line when not Generated -> + abs(Line) + end, + lists:keyreplace(location, 1, Anno, {location, NewLocation}). + +-spec set_line(Line, Anno) -> Anno when + Line :: line(), + Anno :: anno(). + +set_line(Line, Anno) -> + case location(Anno) of + {_Line, Column} -> + set_location({Line, Column}, Anno); + _Line -> + set_location(Line, Anno) + end. + +-spec set_location(Location, Anno) -> Anno when + Location :: location(), + Anno :: anno(). + +set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> + new_location(fix_line(Line, L)); +set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), + ?LLINE(Line) -> + new_location(fix_line(Line, L)); +set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> + new_location(fix_location(Loc, Line)); +set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), + ?LLINE(L), ?LCOLUMN(C) -> + new_location(fix_location(Loc, Line)); +set_location(Location, Anno) -> + _ = set(location, Location, Anno), + {location, OldLocation} = lists:keyfind(location, 1, Anno), + NewLocation = + case {Location, OldLocation} of + {{_Line, _Column}=Loc, {L, _C}} -> + fix_location(Loc, L); + {Line, {L, _C}} -> + fix_line(Line, L); + {{_Line, _Column}=Loc, L} -> + fix_location(Loc, L); + {Line, L} -> + fix_line(Line, L) + end, + lists:keyreplace(location, 1, Anno, {location, NewLocation}). + +fix_location({Line, Column}, OldLine) -> + {fix_line(Line, OldLine), Column}. + +fix_line(Line, OldLine) when OldLine < 0, Line > 0 -> + -Line; +fix_line(Line, _OldLine) -> + Line. + +-spec set_record(Record, Anno) -> Anno when + Record :: record(), + Anno :: anno(). + +set_record(Record, Anno) -> + set(record, Record, Anno). + +-spec set_text(Text, Anno) -> Anno when + Text :: text(), + Anno :: anno(). + +set_text(Text, Anno) -> + set(text, Text, Anno). + +set(Item, Value, Anno) -> + case {is_settable(Item, Value), Anno} of + {true, Line} when ?ALINE(Line) -> + set_anno(Item, Value, [{location, Line}]); + {true, {L, C}=Location} when ?ALINE(L), ?ACOLUMN(C) -> + set_anno(Item, Value, [{location, Location}]); + {true, A} when is_list(A), A =/= [] -> + set_anno(Item, Value, Anno); + _ -> + erlang:error(badarg, [Item, Value, Anno]) + end. + +set_anno(Item, Value, Anno) -> + case default(Item, Value) of + true -> + reset(Anno, Item); + false -> + R = case anno_info(Anno, Item) of + undefined -> + [{Item, Value}|Anno]; + _ -> + lists:keyreplace(Item, 1, Anno, {Item, Value}) + end, + simplify(R) + end. + +reset(Anno, Item) -> + A = lists:keydelete(Item, 1, Anno), + reset_simplify(A). + +-ifdef(DEBUG). +reset_simplify(A) -> + A. +-else. +reset_simplify(A) -> + simplify(A). +-endif. + +simplify([{location, Location}]) -> + Location; +simplify(Anno) -> + Anno. + +anno_info(Anno, Item, Default) -> + try lists:keyfind(Item, 1, Anno) of + false -> + Default; + {Item, Value} -> + Value + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +anno_info(Anno, Item) -> + try lists:keyfind(Item, 1, Anno) of + {Item, Value} -> + Value; + false -> + undefined + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +end_location("", Line, Column) -> + {Line, Column}; +end_location([$\n|String], Line, _Column) -> + end_location(String, Line+1, 1); +end_location([_|String], Line, Column) -> + end_location(String, Line, Column+1). + +end_location("", Line) -> + Line; +end_location([$\n|String], Line) -> + end_location(String, Line+1); +end_location([_|String], Line) -> + end_location(String, Line). + +is_settable(file, File) -> + is_filename(File); +is_settable(generated, Boolean) when Boolean; not Boolean -> + true; +is_settable(location, Line) when ?LLINE(Line) -> + true; +is_settable(location, {Line, Column}) when ?LLINE(Line), ?LCOLUMN(Column) -> + true; +is_settable(record, Boolean) when Boolean; not Boolean -> + true; +is_settable(text, Text) -> + is_string(Text); +is_settable(_, _) -> + false. + +default(generated, false) -> true; +default(record, false) -> true; +default(_, _) -> false. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index e86e10b170..39f833009f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -479,12 +479,13 @@ expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. find_maxline(LC) -> put('$erl_eval_max_line', 0), - F = fun(L) -> + F = fun(A) -> + L = erl_anno:line(A), case is_integer(L) and (L > get('$erl_eval_max_line')) of true -> put('$erl_eval_max_line', L); false -> ok end end, - _ = erl_lint:modify_line(LC, F), + _ = erl_parse:map_anno(F, LC), erase('$erl_eval_max_line'). hide_calls(LC, MaxLine) -> @@ -494,14 +495,16 @@ hide_calls(LC, MaxLine) -> %% v/1 and local calls are hidden. hide({value,L,V}, Id, D) -> - {{atom,Id,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; + A = erl_anno:new(Id), + {{atom,A,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) -> {NArgs, Id, D} = hide(Args, Id0, D0), C = case erl_internal:bif(N, length(Args)) of true -> {call,L,Atom,NArgs}; false -> - {call,Id,{remote,L,{atom,L,m},{atom,L,f}},NArgs} + A = erl_anno:new(Id), + {call,A,{remote,L,{atom,L,m},{atom,L,f}},NArgs} end, {C, Id+1, dict:store(Id, {call,Atom}, D)}; hide(T0, Id0, D0) when is_tuple(T0) -> @@ -514,11 +517,23 @@ hide([E0 | Es0], Id0, D0) -> hide(E, Id, D) -> {E, Id, D}. -unhide_calls({atom,Id,ok}, MaxLine, D) when Id > MaxLine -> - dict:fetch(Id, D); -unhide_calls({call,Id,{remote,L,_M,_F},Args}, MaxLine, D) when Id > MaxLine -> - {call,Atom} = dict:fetch(Id, D), - {call,L,Atom,unhide_calls(Args, MaxLine, D)}; +unhide_calls({atom,A,ok}=E, MaxLine, D) -> + L = erl_anno:line(A), + if + L > MaxLine -> + dict:fetch(L, D); + true -> + E + end; +unhide_calls({call,A,{remote,L,{atom,L,m},{atom,L,f}}=F,Args}, MaxLine, D) -> + Line = erl_anno:line(A), + if + Line > MaxLine -> + {call,Atom} = dict:fetch(Line, D), + {call,L,Atom,unhide_calls(Args, MaxLine, D)}; + true -> + {call,A,F,unhide_calls(Args, MaxLine, D)} + end; unhide_calls(T, MaxLine, D) when is_tuple(T) -> list_to_tuple(unhide_calls(tuple_to_list(T), MaxLine, D)); unhide_calls([E | Es], MaxLine, D) -> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index dc74d611a3..0d3debae22 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-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,8 +38,6 @@ checked_ra=[] % successfully accessed records }). --define(REC_OFFSET, 100000000). % A hundred millions. Also in v3_core. - -spec(module(AbsForms, CompileOptions) -> AbsForms when AbsForms :: [erl_parse:abstract_form()], CompileOptions :: [compile:option()]). @@ -149,7 +147,7 @@ pattern({record_index,Line,Name,Field}, St) -> pattern({record,Line0,Name,Pfs}, St0) -> Fs = record_fields(Name, St0), {TMs,St1} = pattern_list(pattern_fields(Fs, Pfs), St0), - Line = record_offset(Line0, St1), + Line = mark_record(Line0, St1), {{tuple,Line,[{atom,Line0,Name} | TMs]},St1}; pattern({bin,Line,Es0}, St0) -> {Es1,St1} = pattern_bin(Es0, St0), @@ -243,7 +241,7 @@ record_test_in_guard(Line, Term, Name, St) -> expr({atom,Line,false}, St); false -> Fs = record_fields(Name, St), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({call,NLine,{remote,NLine,{atom,NLine,erlang},{atom,NLine,is_record}}, [Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]}, St) @@ -269,7 +267,7 @@ record_test_in_body(Line, Expr, Name, St0) -> %% evaluate to a tuple properly. Fs = record_fields(Name, St0), {Var,St} = new_var(Line, St0), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({block,Line, [{match,Line,Var,Expr}, {call,NLine,{remote,NLine,{atom,NLine,erlang}, @@ -333,7 +331,7 @@ expr({record_index,Line,Name,F}, St) -> I = index_expr(Line, F, Name, record_fields(Name, St)), expr(I, St); expr({record,Line0,Name,Is}, St) -> - Line = record_offset(Line0, St), + Line = mark_record(Line0, St), expr({tuple,Line,[{atom,Line0,Name} | record_inits(record_fields(Name, St), Is)]}, St); @@ -459,7 +457,7 @@ strict_record_access(E0, St0) -> conj([], _E) -> empty; conj([{{Name,_Rp},L,R,Sz} | AL], E) -> - NL = neg_line(L), + NL = no_compiler_warning(L), T1 = {op,NL,'orelse', {call,NL, {remote,NL,{atom,NL,erlang},{atom,NL,is_record}}, @@ -575,8 +573,8 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> Fs = record_fields(Name, St), I = index_expr(F, Fs, 2), P = record_pattern(2, I, Var, length(Fs)+1, Line, [{atom,Line,Name}]), - NLine = neg_line(Line), - RLine = record_offset(NLine, St), + NLine = no_compiler_warning(Line), + RLine = mark_record(NLine, St), E = {'case',NLine,R, [{clause,NLine,[{tuple,RLine,P}],[],[Var]}, {clause,NLine,[{var,NLine,'_'}],[], @@ -590,7 +588,8 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> I = index_expr(Line, Index, Name, Fs), {ExpR,St1} = expr(R, St0), %% Just to make comparison simple: - ExpRp = erl_lint:modify_line(ExpR, fun(_L) -> 0 end), + A0 = erl_anno:new(0), + ExpRp = erl_parse:map_anno(fun(_A) -> A0 end, ExpR), RA = {{Name,ExpRp},Line,ExpR,length(Fs)+1}, St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]}, {{call,Line, @@ -691,8 +690,8 @@ record_update(R, Name, Fs, Us0, St0) -> record_match(R, Name, Lr, Fs, Us, St0) -> {Ps,News,St1} = record_upd_fs(Fs, Us, St0), - NLr = neg_line(Lr), - RLine = record_offset(Lr, St1), + NLr = no_compiler_warning(Lr), + RLine = mark_record(Lr, St1), {{'case',Lr,R, [{clause,Lr,[{tuple,RLine,[{atom,Lr,Name} | Ps]}],[], [{tuple,RLine,[{atom,Lr,Name} | News]}]}, @@ -723,8 +722,8 @@ record_setel(R, Name, Fs, Us0) -> Us = [T || {_,T} <- Us2], Lr = element(2, hd(Us)), Wildcards = duplicate(length(Fs), {var,Lr,'_'}), - NLr = neg_line(Lr), - %% Note: calling record_offset() here is not necessary since it is + NLr = no_compiler_warning(Lr), + %% Note: calling mark_record() here is not necessary since it is %% targeted at Dialyzer which always calls the compiler with %% 'strict_record_updates' meaning that record_setel() will never %% be called. @@ -956,12 +955,11 @@ opt_remove_2({call,Line,{atom,_,is_record}, end; opt_remove_2(A, _) -> A. -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). -record_offset(L, St) -> +mark_record(Anno, St) -> case lists:member(dialyzer, St#exprec.compile) of - true when L >= 0 -> L+?REC_OFFSET; - true when L < 0 -> L-?REC_OFFSET; - false -> L + true -> erl_anno:set_record(true, Anno); + false -> Anno end. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index cbe6eeec3c..821d81a6b4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 +34,8 @@ -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). +-deprecated([{modify_line, 2, next_major_release}]). + %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -76,7 +78,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). --type line() :: erl_scan:line(). % a convenient alias +-type line() :: erl_anno:line(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity @@ -111,7 +113,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> defined=gb_sets:empty() %Defined fuctions :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function - on_load_line=0 :: line(), %Line for on_load + on_load_line=erl_anno:new(0) %Line for on_load + :: erl_anno:anno(), clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated func=[], %Current function @@ -140,7 +143,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type lint_state() :: #lint{}. -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. %% format_error(Error) %% Return a string describing the error. @@ -227,6 +230,8 @@ format_error({deprecated, MFA, ReplacementMFA, Rel}) -> [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({deprecated, {M1, F1, A1}, String}) when is_list(String) -> io_lib:format("~p:~p/~p: ~s", [M1, F1, A1, String]); +format_error({deprecated_type, {M1, F1, A1}, String}) when is_list(String) -> + io_lib:format("~p:~p~s: ~s", [M1, F1, gen_type_paren(A1), String]); format_error({removed, MFA, ReplacementMFA, Rel}) -> io_lib:format("call to ~s will fail, since it was removed in ~s; " "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); @@ -425,13 +430,13 @@ exprs(Exprs, BindingsList) -> exprs_opt(Exprs, BindingsList, Opts) -> {St0,Vs} = foldl(fun({{record,_SequenceNumber,_Name},Attr0}, {St1,Vs1}) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), {attribute_state(Attr, St1),Vs1}; ({V,_}, {St1,Vs1}) -> {St1,[{V,{bound,unused,[]}} | Vs1]} end, {start("nofile",Opts),[]}, BindingsList), Vt = orddict:from_list(Vs), - {_Evt,St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, St0), + {_Evt,St} = exprs(set_file(Exprs, "nofile"), Vt, St0), return_status(St). used_vars(Exprs, BindingsList) -> @@ -439,7 +444,7 @@ used_vars(Exprs, BindingsList) -> ({V,_Val}, Vs0) -> [{V,{bound,unused,[]}} | Vs0] end, [], BindingsList), Vt = orddict:from_list(Vs), - {Evt,_St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, start()), + {Evt,_St} = exprs(set_file(Exprs, "nofile"), Vt, start()), {ok, foldl(fun({V,{_,used,_}}, L) -> [V | L]; (_, L) -> L end, [], Evt)}. @@ -605,8 +610,8 @@ pack_warnings(Ws) -> add_error(E, St) -> St#lint{errors=[{St#lint.file,E}|St#lint.errors]}. -add_error(FileLine, E, St) -> - {File,Location} = loc(FileLine), +add_error(Anno, E, St) -> + {File,Location} = loc(Anno), add_error({Location,erl_lint,E}, St#lint{file = File}). add_warning(W, St) -> St#lint{warnings=[{St#lint.file,W}|St#lint.warnings]}. @@ -615,22 +620,19 @@ add_warning(FileLine, W, St) -> {File,Location} = loc(FileLine), add_warning({Location,erl_lint,W}, St#lint{file = File}). -loc(L) -> - case erl_parse:get_attribute(L, location) of - {location,{{File,Line},Column}} -> - {File,{Line,Column}}; - {location,{File,Line}} -> - {File,Line} - end. +loc(Anno) -> + File = erl_anno:file(Anno), + Location = erl_anno:location(Anno), + {File,Location}. %% forms([Form], State) -> State' forms(Forms0, St0) -> Forms = eval_file_attribute(Forms0, St0), + %% Annotations from now on include the 'file' item. Locals = local_functions(Forms), AutoImportSuppressed = auto_import_suppressed(St0#lint.compile), StDeprecated = disallowed_compile_flags(Forms,St0), - %% Line numbers are from now on pairs {File,Line}. St1 = includes_qlc_hrl(Forms, StDeprecated#lint{locals = Locals, no_auto = AutoImportSuppressed}), St2 = bif_clashes(Forms, St1), @@ -666,15 +668,14 @@ eval_file_attribute(Forms, St) -> eval_file_attr([{attribute,_L,file,{File,_Line}}=Form | Forms], _File) -> [Form | eval_file_attr(Forms, File)]; eval_file_attr([Form0 | Forms], File) -> - Form = zip_file_and_line(Form0, File), + Form = set_file(Form0, File), [Form | eval_file_attr(Forms, File)]; eval_file_attr([], _File) -> []. -zip_file_and_line(T, File) -> - F0 = fun(Line) -> {File,Line} end, - F = fun(L) -> erl_parse:set_line(L, F0) end, - modify_line(T, F). +set_file(T, File) -> + F = fun(Anno) -> erl_anno:set_file(File, Anno) end, + erl_parse:map_anno(F, T). %% form(Form, State) -> State' %% Check a form returning the updated State. Handle generic cases here. @@ -796,9 +797,11 @@ not_deprecated(Forms, St0) -> disallowed_compile_flags(Forms, St0) -> %% There are (still) no line numbers in St0#lint.compile. Errors0 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,nowarn_bif_clash} <- Forms ], + {attribute,A,compile,nowarn_bif_clash} <- Forms, + {_,L} <- [loc(A)] ], Errors1 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,{nowarn_bif_clash, {_,_}}} <- Forms ], + {attribute,A,compile,{nowarn_bif_clash, {_,_}}} <- Forms, + {_,L} <- [loc(A)] ], Disabled = (not is_warn_enabled(bif_clash, St0)), Errors = if Disabled andalso Errors0 =:= [] -> @@ -1299,7 +1302,7 @@ imported(F, A, St) -> error -> no end. --spec on_load(line(), fa(), lint_state()) -> lint_state(). +-spec on_load(erl_anno:anno(), fa(), lint_state()) -> lint_state(). %% Check an on_load directive and remember it. on_load(Line, {Name,Arity}=Fa, #lint{on_load=OnLoad0}=St0) @@ -1954,10 +1957,10 @@ is_guard_test(E) -> is_guard_test(Expression, Forms) -> RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms], St0 = foldl(fun(Attr0, St1) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), attribute_state(Attr, St1) end, start(), RecordAttributes), - is_guard_test2(zip_file_and_line(Expression, "nofile"), St0#lint.records). + is_guard_test2(set_file(Expression, "nofile"), St0#lint.records). %% is_guard_test2(Expression, RecordDefs :: dict:dict()) -> boolean(). is_guard_test2({call,Line,{atom,Lr,record},[E,A]}, RDs) -> @@ -2619,7 +2622,7 @@ type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> %% The record field names and such are checked in the record format. %% We only need to check the types. Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, -1, product, Types}, St0); + check_type({type, nowarn(), product, Types}, St0); type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2628,7 +2631,7 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> StoreType = fun(St) -> NewDefs = dict:store(TypePair, Info, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, + CheckType = {type, nowarn(), product, [ProtoType|Args]}, check_type(CheckType, St#lint{types=NewDefs}) end, case is_default_type(TypePair) of @@ -2684,7 +2687,9 @@ check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) -> check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, - SeenVars, #lint{module=CurrentMod} = St) -> + SeenVars, St0) -> + St = deprecated_type(L, Mod, Name, Args, St0), + CurrentMod = St#lint.module, case Mod =:= CurrentMod of true -> check_type({user_type, L, Name, Args}, SeenVars, St); false -> @@ -2712,7 +2717,7 @@ check_type({type, L, 'fun', [Dom, Range]}, SeenVars, St) -> {type, _, any} -> St; _ -> add_error(L, {type_syntax, 'fun'}, St) end, - check_type({type, -1, product, [Dom, Range]}, SeenVars, St1); + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St1); check_type({type, L, range, [From, To]}, SeenVars, St) -> St1 = case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -2729,7 +2734,7 @@ check_type({type, _L, map, Pairs}, SeenVars, St) -> check_type(Pair, AccSeenVars, AccSt) end, {SeenVars, St}, Pairs); check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) -> - check_type({type, -1, product, [Dom, Range]}, SeenVars, St); + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, L, binary, [Base, Unit]}, SeenVars, St) -> @@ -2772,7 +2777,7 @@ check_type({type, La, TypeName, Args}, SeenVars, St) -> end; _ -> St end, - check_type({type, -1, product, Args}, SeenVars, St1); + check_type({type, nowarn(), product, Args}, SeenVars, St1); check_type({user_type, L, TypeName, Args}, SeenVars, St) -> Arity = length(Args), TypePair = {TypeName, Arity}, @@ -2919,11 +2924,16 @@ check_specs([FunType|Left], Arity, St0) -> true -> St0; false -> add_error(L, spec_wrong_arity, St0) end, - St2 = check_type({type, -1, product, [FunType1|CTypes]}, St1), + St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), check_specs(Left, Arity, St2); check_specs([], _Arity, St) -> St. +nowarn() -> + A0 = erl_anno:new(0), + A1 = erl_anno:set_generated(true, A0), + erl_anno:set_file("", A1). + check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod -> FA = {F, A}, @@ -3452,58 +3462,15 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. %% copy_expr(Expr, Line) -> Expr. %% Make a copy of Expr converting all line numbers to Line. -copy_expr(Expr, Line) -> - modify_line(Expr, fun(_L) -> Line end). +copy_expr(Expr, Anno) -> + erl_parse:map_anno(fun(_A) -> Anno end, Expr). %% modify_line(Form, Fun) -> Form %% modify_line(Expression, Fun) -> Expression %% Applies Fun to each line number occurrence. modify_line(T, F0) -> - modify_line1(T, F0). - -%% Forms. -modify_line1({function,F,A}, _Mf) -> {function,F,A}; -modify_line1({function,M,F,A}, Mf) -> - {function,modify_line1(M, Mf),modify_line1(F, Mf),modify_line1(A, Mf)}; -modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> - {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; -modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> - {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> - {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,opaque,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),opaque,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,Attr,Val}, Mf) -> {attribute,Mf(L),Attr,Val}; -modify_line1({warning,W}, _Mf) -> {warning,W}; -modify_line1({error,W}, _Mf) -> {error,W}; -%% Expressions. -modify_line1({clauses,Cs}, Mf) -> {clauses,modify_line1(Cs, Mf)}; -modify_line1({typed_record_field,Field,Type}, Mf) -> - {typed_record_field,modify_line1(Field, Mf),modify_line1(Type, Mf)}; -modify_line1({Tag,L}, Mf) -> {Tag,Mf(L)}; -modify_line1({Tag,L,E1}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf)}; -modify_line1({Tag,L,E1,E2}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf)}; -modify_line1({bin_element,L,E1,E2,TSL}, Mf) -> - {bin_element,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf), TSL}; -modify_line1({Tag,L,E1,E2,E3}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf),modify_line1(E3, Mf)}; -modify_line1({Tag,L,E1,E2,E3,E4}, Mf) -> - {Tag,Mf(L), - modify_line1(E1, Mf), - modify_line1(E2, Mf), - modify_line1(E3, Mf), - modify_line1(E4, Mf)}; -modify_line1([H|T], Mf) -> - [modify_line1(H, Mf)|modify_line1(T, Mf)]; -modify_line1([], _Mf) -> []; -modify_line1(E, _Mf) when not is_tuple(E), not is_list(E) -> E. + erl_parse:map_anno(F0, T). %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3573,6 +3540,20 @@ deprecated_function(Line, M, F, As, St) -> St end. +deprecated_type(L, M, N, As, St) -> + NAs = length(As), + case otp_internal:obsolete_type(M, N, NAs) of + {deprecated, String} when is_list(String) -> + case is_warn_enabled(deprecated_type, St) of + true -> + add_warning(L, {deprecated_type, {M,N,NAs}, String}, St); + false -> + St + end; + no -> + St + end. + obsolete_guard({call,Line,{atom,Lr,F},As}, St0) -> Arity = length(As), case erl_internal:old_type_test(F, Arity) of diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 3502a50eaa..e328e065e3 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -92,7 +92,7 @@ spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. -typed_record_fields -> '{' typed_exprs '}' : {tuple, ?line('$1'), '$2'}. +typed_record_fields -> '{' typed_exprs '}' : {tuple, ?anno('$1'), '$2'}. typed_exprs -> typed_expr : ['$1']. typed_exprs -> typed_expr ',' typed_exprs : ['$1'|'$3']. @@ -105,26 +105,26 @@ type_sigs -> type_sig : ['$1']. type_sigs -> type_sig ';' type_sigs : ['$1'|'$3']. type_sig -> fun_type : '$1'. -type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, +type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun, ['$1','$3']}. type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, +type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint, ['$1', '$3']}. type_guard -> var '::' top_type : build_def('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. -top_type -> var '::' top_type_100 : {ann_type, ?line('$1'), ['$1','$3']}. +top_type -> var '::' top_type_100 : {ann_type, ?anno('$1'), ['$1','$3']}. top_type -> top_type_100 : '$1'. top_type_100 -> type_200 : '$1'. top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3'). -type_200 -> type_300 '..' type_300 : {type, ?line('$1'), range, +type_200 -> type_300 '..' type_300 : {type, ?anno('$1'), range, [skip_paren('$1'), skip_paren('$3')]}. type_200 -> type_300 : '$1'. @@ -140,61 +140,61 @@ type_400 -> type_500 : '$1'. type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')). type_500 -> type : '$1'. -type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. +type -> '(' top_type ')' : {paren_type, ?anno('$2'), ['$2']}. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). type -> atom '(' top_types ')' : build_type('$1', '$3'). -type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' ')' : {remote_type, ?anno('$1'), ['$1', '$3', []]}. -type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' top_types ')' : {remote_type, ?anno('$1'), ['$1', '$3', '$5']}. -type -> '[' ']' : {type, ?line('$1'), nil, []}. -type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. -type -> '[' top_type ',' '...' ']' : {type, ?line('$1'), +type -> '[' ']' : {type, ?anno('$1'), nil, []}. +type -> '[' top_type ']' : {type, ?anno('$1'), list, ['$2']}. +type -> '[' top_type ',' '...' ']' : {type, ?anno('$1'), nonempty_list, ['$2']}. -type -> '#' '{' '}' : {type, ?line('$1'), map, []}. -type -> '#' '{' map_pair_types '}' : {type, ?line('$1'), map, '$3'}. -type -> '{' '}' : {type, ?line('$1'), tuple, []}. -type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. -type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. -type -> '#' atom '{' field_types '}' : {type, ?line('$1'), +type -> '#' '{' '}' : {type, ?anno('$1'), map, []}. +type -> '#' '{' map_pair_types '}' : {type, ?anno('$1'), map, '$3'}. +type -> '{' '}' : {type, ?anno('$1'), tuple, []}. +type -> '{' top_types '}' : {type, ?anno('$1'), tuple, '$2'}. +type -> '#' atom '{' '}' : {type, ?anno('$1'), record, ['$2']}. +type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. -type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. +type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. fun_type_100 -> '(' '...' ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), any}, '$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), any}, '$5']}. fun_type_100 -> fun_type : '$1'. -fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, []}, '$4']}. +fun_type -> '(' ')' '->' top_type : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, []}, '$4']}. fun_type -> '(' top_types ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, '$2'},'$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, '$2'},'$5']}. map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,['$1','$3']}. +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), map_field_assoc,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. -field_type -> atom '::' top_type : {type, ?line('$1'), field_type, +field_type -> atom '::' top_type : {type, ?anno('$1'), field_type, ['$1', '$3']}. -binary_type -> '<<' '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), - abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_base_type '>>' : {type, ?line('$1'),binary, - ['$2', abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_unit_type '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), '$2']}. +binary_type -> '<<' '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), + abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_base_type '>>' : {type, ?anno('$1'),binary, + ['$2', abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_unit_type '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), '$2']}. binary_type -> '<<' bin_base_type ',' bin_unit_type '>>' - : {type, ?line('$1'), binary, ['$2', '$4']}. + : {type, ?anno('$1'), binary, ['$2', '$4']}. bin_base_type -> var ':' type : build_bin_type(['$1'], '$3'). @@ -210,7 +210,7 @@ function_clauses -> function_clause : ['$1']. function_clauses -> function_clause ';' function_clauses : ['$1'|'$3']. function_clause -> atom clause_args clause_guard clause_body : - {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. + {clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}. clause_args -> argument_list : element(1, '$1'). @@ -221,10 +221,10 @@ clause_guard -> '$empty' : []. clause_body -> '->' exprs: '$2'. -expr -> 'catch' expr : {'catch',?line('$1'),'$2'}. +expr -> 'catch' expr : {'catch',?anno('$1'),'$2'}. expr -> expr_100 : '$1'. -expr_100 -> expr_150 '=' expr_100 : {match,?line('$2'),'$1','$3'}. +expr_100 -> expr_150 '=' expr_100 : {match,?anno('$2'),'$1','$3'}. expr_100 -> expr_150 '!' expr_100 : ?mkop2('$1', '$2', '$3'). expr_100 -> expr_150 : '$1'. @@ -260,7 +260,7 @@ expr_700 -> record_expr : '$1'. expr_700 -> expr_800 : '$1'. expr_800 -> expr_max ':' expr_max : - {remote,?line('$2'),'$1','$3'}. + {remote,?anno('$2'),'$1','$3'}. expr_800 -> expr_max : '$1'. expr_max -> var : '$1'. @@ -272,7 +272,7 @@ expr_max -> binary_comprehension : '$1'. expr_max -> tuple : '$1'. %%expr_max -> struct : '$1'. expr_max -> '(' expr ')' : '$2'. -expr_max -> 'begin' exprs 'end' : {block,?line('$1'),'$2'}. +expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}. expr_max -> if_expr : '$1'. expr_max -> case_expr : '$1'. expr_max -> receive_expr : '$1'. @@ -280,22 +280,22 @@ expr_max -> fun_expr : '$1'. expr_max -> try_expr : '$1'. -list -> '[' ']' : {nil,?line('$1')}. -list -> '[' expr tail : {cons,?line('$1'),'$2','$3'}. +list -> '[' ']' : {nil,?anno('$1')}. +list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}. -tail -> ']' : {nil,?line('$1')}. +tail -> ']' : {nil,?anno('$1')}. tail -> '|' expr ']' : '$2'. -tail -> ',' expr tail : {cons,?line('$2'),'$2','$3'}. +tail -> ',' expr tail : {cons,?anno('$2'),'$2','$3'}. -binary -> '<<' '>>' : {bin,?line('$1'),[]}. -binary -> '<<' bin_elements '>>' : {bin,?line('$1'),'$2'}. +binary -> '<<' '>>' : {bin,?anno('$1'),[]}. +binary -> '<<' bin_elements '>>' : {bin,?anno('$1'),'$2'}. bin_elements -> bin_element : ['$1']. bin_elements -> bin_element ',' bin_elements : ['$1'|'$3']. bin_element -> bit_expr opt_bit_size_expr opt_bit_type_list : - {bin_element,?line('$1'),'$1','$2','$3'}. + {bin_element,?anno('$1'),'$1','$2','$3'}. bit_expr -> prefix_op expr_max : ?mkop1('$1', '$2'). bit_expr -> expr_max : '$1'. @@ -316,29 +316,29 @@ bit_size_expr -> expr_max : '$1'. list_comprehension -> '[' expr '||' lc_exprs ']' : - {lc,?line('$1'),'$2','$4'}. + {lc,?anno('$1'),'$2','$4'}. binary_comprehension -> '<<' binary '||' lc_exprs '>>' : - {bc,?line('$1'),'$2','$4'}. + {bc,?anno('$1'),'$2','$4'}. lc_exprs -> lc_expr : ['$1']. lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. lc_expr -> expr : '$1'. -lc_expr -> expr '<-' expr : {generate,?line('$2'),'$1','$3'}. -lc_expr -> binary '<=' expr : {b_generate,?line('$2'),'$1','$3'}. +lc_expr -> expr '<-' expr : {generate,?anno('$2'),'$1','$3'}. +lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. -tuple -> '{' '}' : {tuple,?line('$1'),[]}. -tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. +tuple -> '{' '}' : {tuple,?anno('$1'),[]}. +tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. %%struct -> atom tuple : -%% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. +%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}. map_expr -> '#' map_tuple : - {map, ?line('$1'),'$2'}. + {map, ?anno('$1'),'$2'}. map_expr -> expr_max '#' map_tuple : - {map, ?line('$2'),'$1','$3'}. + {map, ?anno('$2'),'$1','$3'}. map_expr -> map_expr '#' map_tuple : - {map, ?line('$2'),'$1','$3'}. + {map, ?anno('$2'),'$1','$3'}. map_tuple -> '{' '}' : []. map_tuple -> '{' map_fields '}' : '$2'. @@ -350,10 +350,10 @@ map_field -> map_field_assoc : '$1'. map_field -> map_field_exact : '$1'. map_field_assoc -> map_key '=>' expr : - {map_field_assoc,?line('$1'),'$1','$3'}. + {map_field_assoc,?anno('$1'),'$1','$3'}. map_field_exact -> map_key ':=' expr : - {map_field_exact,?line('$1'),'$1','$3'}. + {map_field_exact,?anno('$1'),'$1','$3'}. map_key -> expr : '$1'. @@ -363,17 +363,17 @@ map_key -> expr : '$1'. %% always atoms for the moment, this might change in the future. record_expr -> '#' atom '.' atom : - {record_index,?line('$1'),element(3, '$2'),'$4'}. + {record_index,?anno('$1'),element(3, '$2'),'$4'}. record_expr -> '#' atom record_tuple : - {record,?line('$1'),element(3, '$2'),'$3'}. + {record,?anno('$1'),element(3, '$2'),'$3'}. record_expr -> expr_max '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> expr_max '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_expr -> record_expr '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> record_expr '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_tuple -> '{' '}' : []. record_tuple -> '{' record_fields '}' : '$2'. @@ -381,47 +381,47 @@ record_tuple -> '{' record_fields '}' : '$2'. record_fields -> record_field : ['$1']. record_fields -> record_field ',' record_fields : ['$1' | '$3']. -record_field -> var '=' expr : {record_field,?line('$1'),'$1','$3'}. -record_field -> atom '=' expr : {record_field,?line('$1'),'$1','$3'}. +record_field -> var '=' expr : {record_field,?anno('$1'),'$1','$3'}. +record_field -> atom '=' expr : {record_field,?anno('$1'),'$1','$3'}. %% N.B. This is called from expr_700. function_call -> expr_800 argument_list : - {call,?line('$1'),'$1',element(1, '$2')}. + {call,?anno('$1'),'$1',element(1, '$2')}. -if_expr -> 'if' if_clauses 'end' : {'if',?line('$1'),'$2'}. +if_expr -> 'if' if_clauses 'end' : {'if',?anno('$1'),'$2'}. if_clauses -> if_clause : ['$1']. if_clauses -> if_clause ';' if_clauses : ['$1' | '$3']. if_clause -> guard clause_body : - {clause,?line(hd(hd('$1'))),[],'$1','$2'}. + {clause,?anno(hd(hd('$1'))),[],'$1','$2'}. case_expr -> 'case' expr 'of' cr_clauses 'end' : - {'case',?line('$1'),'$2','$4'}. + {'case',?anno('$1'),'$2','$4'}. cr_clauses -> cr_clause : ['$1']. cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3']. cr_clause -> expr clause_guard clause_body : - {clause,?line('$1'),['$1'],'$2','$3'}. + {clause,?anno('$1'),['$1'],'$2','$3'}. receive_expr -> 'receive' cr_clauses 'end' : - {'receive',?line('$1'),'$2'}. + {'receive',?anno('$1'),'$2'}. receive_expr -> 'receive' 'after' expr clause_body 'end' : - {'receive',?line('$1'),[],'$3','$4'}. + {'receive',?anno('$1'),[],'$3','$4'}. receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : - {'receive',?line('$1'),'$2','$4','$5'}. + {'receive',?anno('$1'),'$2','$4','$5'}. fun_expr -> 'fun' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. + {'fun',?anno('$1'),{function,element(3, '$2'),element(3, '$4')}}. fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : - {'fun',?line('$1'),{function,'$2','$4','$6'}}. + {'fun',?anno('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : - build_fun(?line('$1'), '$2'). + build_fun(?anno('$1'), '$2'). atom_or_var -> atom : '$1'. atom_or_var -> var : '$1'. @@ -433,16 +433,16 @@ fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. fun_clause -> argument_list clause_guard clause_body : - {Args,Pos} = '$1', - {clause,Pos,'fun',Args,'$2','$3'}. + {Args,Anno} = '$1', + {clause,Anno,'fun',Args,'$2','$3'}. fun_clause -> var argument_list clause_guard clause_body : {clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}. try_expr -> 'try' exprs 'of' cr_clauses try_catch : - build_try(?line('$1'),'$2','$4','$5'). + build_try(?anno('$1'),'$2','$4','$5'). try_expr -> 'try' exprs try_catch : - build_try(?line('$1'),'$2',[],'$3'). + build_try(?anno('$1'),'$2',[],'$3'). try_catch -> 'catch' try_clauses 'end' : {'$2',[]}. @@ -455,18 +455,18 @@ try_clauses -> try_clause : ['$1']. try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. try_clause -> expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,[{atom,L,throw},'$1',{var,L,'_'}]}],'$2','$3'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}. try_clause -> atom ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. try_clause -> var ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. -argument_list -> '(' ')' : {[],?line('$1')}. -argument_list -> '(' exprs ')' : {'$2',?line('$1')}. +argument_list -> '(' ')' : {[],?anno('$1')}. +argument_list -> '(' exprs ')' : {'$2',?anno('$1')}. exprs -> expr : ['$1']. @@ -483,7 +483,7 @@ atomic -> strings : '$1'. strings -> string : '$1'. strings -> string strings : - {string,?line('$1'),element(3, '$1') ++ element(3, '$2')}. + {string,?anno('$1'),element(3, '$1') ++ element(3, '$2')}. prefix_op -> '+' : '$1'. prefix_op -> '-' : '$1'. @@ -524,8 +524,14 @@ Erlang code. -export([normalise/1,abstract/1,tokens/1,tokens/2]). -export([abstract/2]). -export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). +-export([map_anno/2, fold_anno/3, mapfold_anno/3, + new_anno/1, anno_to_term/1, anno_from_term/1]). -export([set_line/2,get_attribute/2,get_attributes/1]). +-deprecated([{set_line, 2, next_major_release}, + {get_attribute, 2, next_major_release}, + {get_attributes, 1, next_major_release}]). + %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. -compile([{hipe,[{regalloc,linear_scan}]}]). @@ -533,30 +539,31 @@ Erlang code. -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, error_info/0]). +%% XXX. To be refined. -type abstract_clause() :: term(). -type abstract_expr() :: term(). -type abstract_form() :: term(). -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. -type token() :: erl_scan:token(). -%% mkop(Op, Arg) -> {op,Line,Op,Arg}. -%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. +%% mkop(Op, Arg) -> {op,Anno,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Anno,Op,Left,Right}. --define(mkop2(L, OpPos, R), +-define(mkop2(L, OpAnno, R), begin - {Op,Pos} = OpPos, - {op,Pos,Op,L,R} + {Op,Anno} = OpAnno, + {op,Anno,Op,L,R} end). --define(mkop1(OpPos, A), +-define(mkop1(OpAnno, A), begin - {Op,Pos} = OpPos, - {op,Pos,Op,A} + {Op,Anno} = OpAnno, + {op,Anno,Op,A} end). -%% keep track of line info in tokens --define(line(Tup), element(2, Tup)). +%% keep track of annotation info in tokens +-define(anno(Tup), element(2, Tup)). %% Entry points compatible to old erl_parse. %% These really suck and are only here until Calle gets multiple @@ -566,10 +573,10 @@ Erlang code. Tokens :: [token()], AbsForm :: abstract_form(), ErrorInfo :: error_info(). -parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> - parse([{'-',L1},{'spec',L2}|Tokens]); -parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> - parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form([{'-',A1},{atom,A2,spec}|Tokens]) -> + parse([{'-',A1},{'spec',A2}|Tokens]); +parse_form([{'-',A1},{atom,A2,callback}|Tokens]) -> + parse([{'-',A1},{'callback',A2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -578,7 +585,8 @@ parse_form(Tokens) -> ExprList :: [abstract_expr()], ErrorInfo :: error_info(). parse_exprs(Tokens) -> - case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> {ok,Exprs}; {error,_} = Err -> Err @@ -589,42 +597,43 @@ parse_exprs(Tokens) -> Term :: term(), ErrorInfo :: error_info(). parse_term(Tokens) -> - case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of - {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of + {ok,{function,_Af,f,0,[{clause,_Ac,[],[],[Expr]}]}} -> try normalise(Expr) of Term -> {ok,Term} catch - _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + _:_R -> {error,{location(?anno(Expr)),?MODULE,"bad term"}} end; - {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> - {error,{?line(E2),?MODULE,"bad term"}}; + {ok,{function,_Af,f,A,[{clause,_Ac,[],[],[_E1,E2|_Es]}]}} -> + {error,{location(?anno(E2)),?MODULE,"bad term"}}; {error,_} = Err -> Err end. -type attributes() :: 'export' | 'file' | 'import' | 'module' | 'opaque' | 'record' | 'type'. -build_typed_attribute({atom,La,record}, - {typed_record, {atom,_Ln,RecordName}, RecTuple}) -> - {attribute,La,record,{RecordName,record_tuple(RecTuple)}}; -build_typed_attribute({atom,La,Attr}, +build_typed_attribute({atom,Aa,record}, + {typed_record, {atom,_An,RecordName}, RecTuple}) -> + {attribute,Aa,record,{RecordName,record_tuple(RecTuple)}}; +build_typed_attribute({atom,Aa,Attr}, {type_def, {call,_,{atom,_,TypeName},Args}, Type}) when Attr =:= 'type' ; Attr =:= 'opaque' -> case lists:all(fun({var, _, _}) -> true; (_) -> false end, Args) of - true -> {attribute,La,Attr,{TypeName,Type,Args}}; - false -> error_bad_decl(La, Attr) + true -> {attribute,Aa,Attr,{TypeName,Type,Args}}; + false -> error_bad_decl(Aa, Attr) end; -build_typed_attribute({atom,La,Attr},_) -> +build_typed_attribute({atom,Aa,Attr},_) -> case Attr of - record -> error_bad_decl(La, record); - type -> error_bad_decl(La, type); - opaque -> error_bad_decl(La, opaque); - _ -> ret_err(La, "bad attribute") + record -> error_bad_decl(Aa, record); + type -> error_bad_decl(Aa, type); + opaque -> error_bad_decl(Aa, opaque); + _ -> ret_err(Aa, "bad attribute") end. -build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) +build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of @@ -639,7 +648,7 @@ build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. + {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, @@ -651,40 +660,40 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). -build_def({var, L, '_'}, _Types) -> - ret_err(L, "bad type variable"); +build_def({var, A, '_'}, _Types) -> + ret_err(A, "bad type variable"); build_def(LHS, Types) -> - IsSubType = {atom, ?line(LHS), is_subtype}, - {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. + IsSubType = {atom, ?anno(LHS), is_subtype}, + {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}. -lift_unions(T1, {type, _La, union, List}) -> - {type, ?line(T1), union, [T1|List]}; +lift_unions(T1, {type, _Aa, union, List}) -> + {type, ?anno(T1), union, [T1|List]}; lift_unions(T1, T2) -> - {type, ?line(T1), union, [T1, T2]}. + {type, ?anno(T1), union, [T1, T2]}. -skip_paren({paren_type,_L,[Type]}) -> +skip_paren({paren_type,_A,[Type]}) -> skip_paren(Type); skip_paren(Type) -> Type. -build_gen_type({atom, La, tuple}) -> - {type, La, tuple, any}; -build_gen_type({atom, La, map}) -> - {type, La, map, any}; -build_gen_type({atom, La, Name}) -> +build_gen_type({atom, Aa, tuple}) -> + {type, Aa, tuple, any}; +build_gen_type({atom, Aa, map}) -> + {type, Aa, map, any}; +build_gen_type({atom, Aa, Name}) -> Tag = type_tag(Name, 0), - {Tag, La, Name, []}. + {Tag, Aa, Name, []}. build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); build_bin_type([], Int) -> skip_paren(Int); -build_bin_type([{var, La, _}|_], _) -> - ret_err(La, "Bad binary type"). +build_bin_type([{var, Aa, _}|_], _) -> + ret_err(Aa, "Bad binary type"). -build_type({atom, L, Name}, Types) -> +build_type({atom, A, Name}, Types) -> Tag = type_tag(Name, length(Types)), - {Tag, L, Name, Types}. + {Tag, A, Name, Types}. type_tag(TypeName, NumberOfTypeVariables) -> case erl_internal:is_type(TypeName, NumberOfTypeVariables) of @@ -692,71 +701,75 @@ type_tag(TypeName, NumberOfTypeVariables) -> false -> user_type end. +abstract2(Term, Anno) -> + Line = erl_anno:line(Anno), + abstract(Term, Line). + %% build_attribute(AttrName, AttrValue) -> -%% {attribute,Line,module,Module} -%% {attribute,Line,export,Exports} -%% {attribute,Line,import,Imports} -%% {attribute,Line,record,{Name,Inits}} -%% {attribute,Line,file,{Name,Line}} -%% {attribute,Line,Name,Val} - -build_attribute({atom,La,module}, Val) -> +%% {attribute,Anno,module,Module} +%% {attribute,Anno,export,Exports} +%% {attribute,Anno,import,Imports} +%% {attribute,Anno,record,{Name,Inits}} +%% {attribute,Anno,file,{Name,Line}} +%% {attribute,Anno,Name,Val} + +build_attribute({atom,Aa,module}, Val) -> case Val of - [{atom,_Lm,Module}] -> - {attribute,La,module,Module}; - [{atom,_Lm,Module},ExpList] -> - {attribute,La,module,{Module,var_list(ExpList)}}; + [{atom,_Am,Module}] -> + {attribute,Aa,module,Module}; + [{atom,_Am,Module},ExpList] -> + {attribute,Aa,module,{Module,var_list(ExpList)}}; _Other -> - error_bad_decl(La, module) + error_bad_decl(Aa, module) end; -build_attribute({atom,La,export}, Val) -> +build_attribute({atom,Aa,export}, Val) -> case Val of [ExpList] -> - {attribute,La,export,farity_list(ExpList)}; - _Other -> error_bad_decl(La, export) + {attribute,Aa,export,farity_list(ExpList)}; + _Other -> error_bad_decl(Aa, export) end; -build_attribute({atom,La,import}, Val) -> +build_attribute({atom,Aa,import}, Val) -> case Val of - [{atom,_Lm,Mod},ImpList] -> - {attribute,La,import,{Mod,farity_list(ImpList)}}; - _Other -> error_bad_decl(La, import) + [{atom,_Am,Mod},ImpList] -> + {attribute,Aa,import,{Mod,farity_list(ImpList)}}; + _Other -> error_bad_decl(Aa, import) end; -build_attribute({atom,La,record}, Val) -> +build_attribute({atom,Aa,record}, Val) -> case Val of - [{atom,_Ln,Record},RecTuple] -> - {attribute,La,record,{Record,record_tuple(RecTuple)}}; - _Other -> error_bad_decl(La, record) + [{atom,_An,Record},RecTuple] -> + {attribute,Aa,record,{Record,record_tuple(RecTuple)}}; + _Other -> error_bad_decl(Aa, record) end; -build_attribute({atom,La,file}, Val) -> +build_attribute({atom,Aa,file}, Val) -> case Val of - [{string,_Ln,Name},{integer,_Ll,Line}] -> - {attribute,La,file,{Name,Line}}; - _Other -> error_bad_decl(La, file) + [{string,_An,Name},{integer,_Al,Line}] -> + {attribute,Aa,file,{Name,Line}}; + _Other -> error_bad_decl(Aa, file) end; -build_attribute({atom,La,Attr}, Val) -> +build_attribute({atom,Aa,Attr}, Val) -> case Val of [Expr0] -> Expr = attribute_farity(Expr0), - {attribute,La,Attr,term(Expr)}; - _Other -> ret_err(La, "bad attribute") + {attribute,Aa,Attr,term(Expr)}; + _Other -> ret_err(Aa, "bad attribute") end. -var_list({cons,_Lc,{var,_,V},Tail}) -> +var_list({cons,_Ac,{var,_,V},Tail}) -> [V|var_list(Tail)]; -var_list({nil,_Ln}) -> []; +var_list({nil,_An}) -> []; var_list(Other) -> - ret_err(?line(Other), "bad variable list"). + ret_err(?anno(Other), "bad variable list"). -attribute_farity({cons,L,H,T}) -> - {cons,L,attribute_farity(H),attribute_farity(T)}; -attribute_farity({tuple,L,Args0}) -> +attribute_farity({cons,A,H,T}) -> + {cons,A,attribute_farity(H),attribute_farity(T)}; +attribute_farity({tuple,A,Args0}) -> Args = attribute_farity_list(Args0), - {tuple,L,Args}; -attribute_farity({map,L,Args0}) -> + {tuple,A,Args}; +attribute_farity({map,A,Args0}) -> Args = attribute_farity_map(Args0), - {map,L,Args}; -attribute_farity({op,L,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> - {tuple,L,[Name,Arity]}; + {map,A,Args}; +attribute_farity({op,A,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> + {tuple,A,[Name,Arity]}; attribute_farity(Other) -> Other. attribute_farity_list(Args) -> @@ -764,45 +777,45 @@ attribute_farity_list(Args) -> %% It is not meaningful to have farity keys. attribute_farity_map(Args) -> - [{Op,L,K,attribute_farity(V)} || {Op,L,K,V} <- Args]. + [{Op,A,K,attribute_farity(V)} || {Op,A,K,V} <- Args]. --spec error_bad_decl(integer(), attributes()) -> no_return(). +-spec error_bad_decl(erl_anno:anno(), attributes()) -> no_return(). -error_bad_decl(L, S) -> - ret_err(L, io_lib:format("bad ~w declaration", [S])). +error_bad_decl(Anno, S) -> + ret_err(Anno, io_lib:format("bad ~w declaration", [S])). -farity_list({cons,_Lc,{op,_Lo,'/',{atom,_La,A},{integer,_Li,I}},Tail}) -> +farity_list({cons,_Ac,{op,_Ao,'/',{atom,_Aa,A},{integer,_Ai,I}},Tail}) -> [{A,I}|farity_list(Tail)]; -farity_list({nil,_Ln}) -> []; +farity_list({nil,_An}) -> []; farity_list(Other) -> - ret_err(?line(Other), "bad function arity"). + ret_err(?anno(Other), "bad function arity"). -record_tuple({tuple,_Lt,Fields}) -> +record_tuple({tuple,_At,Fields}) -> record_fields(Fields); record_tuple(Other) -> - ret_err(?line(Other), "bad record declaration"). + ret_err(?anno(Other), "bad record declaration"). -record_fields([{atom,La,A}|Fields]) -> - [{record_field,La,{atom,La,A}}|record_fields(Fields)]; -record_fields([{match,_Lm,{atom,La,A},Expr}|Fields]) -> - [{record_field,La,{atom,La,A},Expr}|record_fields(Fields)]; +record_fields([{atom,Aa,A}|Fields]) -> + [{record_field,Aa,{atom,Aa,A}}|record_fields(Fields)]; +record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> + [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), TypeInfo1 = case Expr of {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, La, _} -> + {atom, Aa, _} -> case has_undefined(TypeInfo) of false -> TypeInfo2 = maybe_add_paren(TypeInfo), - lift_unions(abstract(undefined, La), TypeInfo2); + lift_unions(abstract2(undefined, Aa), TypeInfo2); true -> TypeInfo end end, [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; record_fields([Other|_Fields]) -> - ret_err(?line(Other), "bad record field"); + ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. has_undefined({atom,_,undefined}) -> @@ -816,52 +829,53 @@ has_undefined({type,_,union,Ts}) -> has_undefined(_) -> false. -maybe_add_paren({ann_type,L,T}) -> - {paren_type,L,[{ann_type,L,T}]}; +maybe_add_paren({ann_type,A,T}) -> + {paren_type,A,[{ann_type,A,T}]}; maybe_add_paren(T) -> T. term(Expr) -> try normalise(Expr) - catch _:_R -> ret_err(?line(Expr), "bad attribute") + catch _:_R -> ret_err(?anno(Expr), "bad attribute") end. -%% build_function([Clause]) -> {function,Line,Name,Arity,[Clause]} +%% build_function([Clause]) -> {function,Anno,Name,Arity,[Clause]} build_function(Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), - {function,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. + {function,?anno(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. -%% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. +%% build_fun(Anno, [Clause]) -> {'fun',Anno,{clauses,[Clause]}}. -build_fun(Line, Cs) -> +build_fun(Anno, Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), CheckedCs = check_clauses(Cs, Name, Arity), case Name of 'fun' -> - {'fun',Line,{clauses,CheckedCs}}; + {'fun',Anno,{clauses,CheckedCs}}; Name -> - {named_fun,Line,Name,CheckedCs} + {named_fun,Anno,Name,CheckedCs} end. check_clauses(Cs, Name, Arity) -> [case C of - {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity -> - {clause,L,As,G,B}; - {clause,L,_N,_As,_G,_B} -> - ret_err(L, "head mismatch") + {clause,A,N,As,G,B} when N =:= Name, length(As) =:= Arity -> + {clause,A,As,G,B}; + {clause,A,_N,_As,_G,_B} -> + ret_err(A, "head mismatch") end || C <- Cs]. -build_try(L,Es,Scs,{Ccs,As}) -> - {'try',L,Es,Scs,Ccs,As}. +build_try(A,Es,Scs,{Ccs,As}) -> + {'try',A,Es,Scs,Ccs,As}. -spec ret_err(_, _) -> no_return(). -ret_err(L, S) -> - {location,Location} = get_attribute(L, location), - return_error(Location, S). +ret_err(Anno, S) -> + return_error(location(Anno), S). +location(Anno) -> + erl_anno:location(Anno). %% Convert between the abstract form of a term and a term. @@ -909,7 +923,8 @@ normalise_list([]) -> Data :: term(), AbsTerm :: abstract_expr(). abstract(T) -> - abstract(T, 0, enc_func(epp:default_encoding())). + Anno = erl_anno:new(0), + abstract(T, Anno, enc_func(epp:default_encoding())). -type encoding_func() :: fun((non_neg_integer()) -> boolean()). @@ -919,16 +934,18 @@ abstract(T) -> Options :: Line | [Option], Option :: {line, Line} | {encoding, Encoding}, Encoding :: 'latin1' | 'unicode' | 'utf8' | 'none' | encoding_func(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), AbsTerm :: abstract_expr(). abstract(T, Line) when is_integer(Line) -> - abstract(T, Line, enc_func(epp:default_encoding())); + Anno = erl_anno:new(Line), + abstract(T, Anno, enc_func(epp:default_encoding())); abstract(T, Options) when is_list(Options) -> Line = proplists:get_value(line, Options, 0), Encoding = proplists:get_value(encoding, Options,epp:default_encoding()), EncFunc = enc_func(Encoding), - abstract(T, Line, EncFunc). + Anno = erl_anno:new(Line), + abstract(T, Anno, EncFunc). -define(UNICODE(C), (C < 16#D800 orelse @@ -942,53 +959,53 @@ enc_func(none) -> none; enc_func(Fun) when is_function(Fun, 1) -> Fun; enc_func(Term) -> erlang:error({badarg, Term}). -abstract(T, L, _E) when is_integer(T) -> {integer,L,T}; -abstract(T, L, _E) when is_float(T) -> {float,L,T}; -abstract(T, L, _E) when is_atom(T) -> {atom,L,T}; -abstract([], L, _E) -> {nil,L}; -abstract(B, L, _E) when is_bitstring(B) -> - {bin, L, [abstract_byte(Byte, L) || Byte <- bitstring_to_list(B)]}; -abstract([H|T], L, none=E) -> - {cons,L,abstract(H, L, E),abstract(T, L, E)}; -abstract(List, L, E) when is_list(List) -> - abstract_list(List, [], L, E); -abstract(Tuple, L, E) when is_tuple(Tuple) -> - {tuple,L,abstract_tuple_list(tuple_to_list(Tuple), L, E)}; -abstract(Map, L, E) when is_map(Map) -> - {map,L,abstract_map_fields(maps:to_list(Map),L,E)}. - -abstract_list([H|T], String, L, E) -> +abstract(T, A, _E) when is_integer(T) -> {integer,A,T}; +abstract(T, A, _E) when is_float(T) -> {float,A,T}; +abstract(T, A, _E) when is_atom(T) -> {atom,A,T}; +abstract([], A, _E) -> {nil,A}; +abstract(B, A, _E) when is_bitstring(B) -> + {bin, A, [abstract_byte(Byte, A) || Byte <- bitstring_to_list(B)]}; +abstract([H|T], A, none=E) -> + {cons,A,abstract(H, A, E),abstract(T, A, E)}; +abstract(List, A, E) when is_list(List) -> + abstract_list(List, [], A, E); +abstract(Tuple, A, E) when is_tuple(Tuple) -> + {tuple,A,abstract_tuple_list(tuple_to_list(Tuple), A, E)}; +abstract(Map, A, E) when is_map(Map) -> + {map,A,abstract_map_fields(maps:to_list(Map),A,E)}. + +abstract_list([H|T], String, A, E) -> case is_integer(H) andalso H >= 0 andalso E(H) of true -> - abstract_list(T, [H|String], L, E); + abstract_list(T, [H|String], A, E); false -> - AbstrList = {cons,L,abstract(H, L, E),abstract(T, L, E)}, - not_string(String, AbstrList, L, E) + AbstrList = {cons,A,abstract(H, A, E),abstract(T, A, E)}, + not_string(String, AbstrList, A, E) end; -abstract_list([], String, L, _E) -> - {string, L, lists:reverse(String)}; -abstract_list(T, String, L, E) -> - not_string(String, abstract(T, L, E), L, E). - -not_string([C|T], Result, L, E) -> - not_string(T, {cons, L, {integer, L, C}, Result}, L, E); -not_string([], Result, _L, _E) -> +abstract_list([], String, A, _E) -> + {string, A, lists:reverse(String)}; +abstract_list(T, String, A, E) -> + not_string(String, abstract(T, A, E), A, E). + +not_string([C|T], Result, A, E) -> + not_string(T, {cons, A, {integer, A, C}, Result}, A, E); +not_string([], Result, _A, _E) -> Result. -abstract_tuple_list([H|T], L, E) -> - [abstract(H, L, E)|abstract_tuple_list(T, L, E)]; -abstract_tuple_list([], _L, _E) -> +abstract_tuple_list([H|T], A, E) -> + [abstract(H, A, E)|abstract_tuple_list(T, A, E)]; +abstract_tuple_list([], _A, _E) -> []. -abstract_map_fields(Fs,L,E) -> - [{map_field_assoc,L,abstract(K,L,E),abstract(V,L,E)}||{K,V}<-Fs]. +abstract_map_fields(Fs,A,E) -> + [{map_field_assoc,A,abstract(K,A,E),abstract(V,A,E)}||{K,V}<-Fs]. -abstract_byte(Byte, L) when is_integer(Byte) -> - {bin_element, L, {integer, L, Byte}, default, default}; -abstract_byte(Bits, L) -> +abstract_byte(Byte, A) when is_integer(Byte) -> + {bin_element, A, {integer, A, Byte}, default, default}; +abstract_byte(Bits, A) -> Sz = bit_size(Bits), <<Val:Sz>> = Bits, - {bin_element, L, {integer, L, Val}, {integer, L, Sz}, default}. + {bin_element, A, {integer, A, Val}, {integer, A, Sz}, default}. %% Generate a list of tokens representing the abstract term. @@ -1002,32 +1019,32 @@ tokens(Abs) -> AbsTerm :: abstract_expr(), MoreTokens :: [token()], Tokens :: [token()]. -tokens({char,L,C}, More) -> [{char,L,C}|More]; -tokens({integer,L,N}, More) -> [{integer,L,N}|More]; -tokens({float,L,F}, More) -> [{float,L,F}|More]; -tokens({atom,L,A}, More) -> [{atom,L,A}|More]; -tokens({var,L,V}, More) -> [{var,L,V}|More]; -tokens({string,L,S}, More) -> [{string,L,S}|More]; -tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; -tokens({cons,L,Head,Tail}, More) -> - [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; -tokens({tuple,L,[]}, More) -> - [{'{',L},{'}',L}|More]; -tokens({tuple,L,[E|Es]}, More) -> - [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. - -tokens_tail({cons,L,Head,Tail}, More) -> - [{',',L}|tokens(Head, tokens_tail(Tail, More))]; -tokens_tail({nil,L}, More) -> - [{']',L}|More]; +tokens({char,A,C}, More) -> [{char,A,C}|More]; +tokens({integer,A,N}, More) -> [{integer,A,N}|More]; +tokens({float,A,F}, More) -> [{float,A,F}|More]; +tokens({atom,Aa,A}, More) -> [{atom,Aa,A}|More]; +tokens({var,A,V}, More) -> [{var,A,V}|More]; +tokens({string,A,S}, More) -> [{string,A,S}|More]; +tokens({nil,A}, More) -> [{'[',A},{']',A}|More]; +tokens({cons,A,Head,Tail}, More) -> + [{'[',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,A,[]}, More) -> + [{'{',A},{'}',A}|More]; +tokens({tuple,A,[E|Es]}, More) -> + [{'{',A}|tokens(E, tokens_tuple(Es, ?anno(E), More))]. + +tokens_tail({cons,A,Head,Tail}, More) -> + [{',',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,A}, More) -> + [{']',A}|More]; tokens_tail(Other, More) -> - L = ?line(Other), - [{'|',L}|tokens(Other, [{']',L}|More])]. + A = ?anno(Other), + [{'|',A}|tokens(Other, [{']',A}|More])]. -tokens_tuple([E|Es], Line, More) -> - [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; -tokens_tuple([], Line, More) -> - [{'}',Line}|More]. +tokens_tuple([E|Es], Anno, More) -> + [{',',Anno}|tokens(E, tokens_tuple(Es, ?anno(E), More))]; +tokens_tuple([], Anno, More) -> + [{'}',Anno}|More]. %% Give the relative precedences of operators. @@ -1092,13 +1109,168 @@ max_prec() -> 900. %%% longer apply. To get all present attributes as a property list %%% get_attributes() should be used. +-compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}). set_line(L, F) -> erl_scan:set_attribute(line, L, F). +-compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}). get_attribute(L, Name) -> erl_scan:attributes_info(L, Name). +-compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}). get_attributes(L) -> erl_scan:attributes_info(L). +-spec map_anno(Fun, Abstr) -> NewAbstr when + Fun :: fun((Anno) -> Anno), + Anno :: erl_anno:anno(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +map_anno(F0, Abstr) -> + F = fun(A, Acc) -> {F0(A), Acc} end, + {NewAbstr, []} = modify_anno1(Abstr, [], F), + NewAbstr. + +-spec fold_anno(Fun, Acc0, Abstr) -> NewAbstr when + Fun :: fun((Anno, AccIn) -> AccOut), + Anno :: erl_anno:anno(), + Acc0 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +fold_anno(F0, Acc0, Abstr) -> + F = fun(A, Acc) -> {A, F0(A, Acc)} end, + {_, NewAcc} = modify_anno1(Abstr, Acc0, F), + NewAcc. + +-spec mapfold_anno(Fun, Acc0, Abstr) -> {NewAbstr, Acc1} when + Fun :: fun((Anno, AccIn) -> {Anno, AccOut}), + Anno :: erl_anno:anno(), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +mapfold_anno(F, Acc0, Abstr) -> + modify_anno1(Abstr, Acc0, F). + +-spec new_anno(Term) -> Abstr when + Term :: term(), + Abstr :: abstract_form() | abstract_expr(). + +new_anno(Term) -> + map_anno(fun erl_anno:new/1, Term). + +-spec anno_to_term(Abstr) -> term() when + Abstr :: abstract_form() | abstract_expr(). + +anno_to_term(Abstract) -> + map_anno(fun erl_anno:to_term/1, Abstract). + +-spec anno_from_term(Term) -> abstract_form() | abstract_expr() when + Term :: term(). + +anno_from_term(Term) -> + map_anno(fun erl_anno:from_term/1, Term). + +%% Forms. +%% Recognize what sys_pre_expand does: +modify_anno1({'fun',A,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{'fun',A1,F1,Id},Ac2}; +modify_anno1({named_fun,A,N,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{named_fun,A1,N,F1,Id},Ac2}; +modify_anno1({attribute,A,N,[V]}, Ac, Mf) -> + {{attribute,A1,N1,V1},Ac1} = modify_anno1({attribute,A,N,V}, Ac, Mf), + {{attribute,A1,N1,[V1]},Ac1}; +%% End of sys_pre_expand special forms. +modify_anno1({function,F,A}, Ac, _Mf) -> + {{function,F,A},Ac}; +modify_anno1({function,M,F,A}, Ac, Mf) -> + {M1,Ac1} = modify_anno1(M, Ac, Mf), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {A1,Ac3} = modify_anno1(A, Ac2, Mf), + {{function,M1,F1,A1},Ac3}; +modify_anno1({attribute,A,record,{Name,Fields}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Fields1,Ac2} = modify_anno1(Fields, Ac1, Mf), + {{attribute,A1,record,{Name,Fields1}},Ac2}; +modify_anno1({attribute,A,spec,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,spec,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,callback,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,callback,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,type,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,type,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,opaque,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,opaque,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,Attr,Val}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{attribute,A1,Attr,Val},Ac1}; +modify_anno1({warning,W}, Ac, _Mf) -> + {{warning,W},Ac}; +modify_anno1({error,W}, Ac, _Mf) -> + {{error,W},Ac}; +%% Expressions. +modify_anno1({clauses,Cs}, Ac, Mf) -> + {Cs1,Ac1} = modify_anno1(Cs, Ac, Mf), + {{clauses,Cs1},Ac1}; +modify_anno1({typed_record_field,Field,Type}, Ac, Mf) -> + {Field1,Ac1} = modify_anno1(Field, Ac, Mf), + {Type1,Ac2} = modify_anno1(Type, Ac1, Mf), + {{typed_record_field,Field1,Type1},Ac2}; +modify_anno1({Tag,A}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{Tag,A1},Ac1}; +modify_anno1({Tag,A,E1}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {{Tag,A1,E11},Ac2}; +modify_anno1({Tag,A,E1,E2}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{Tag,A1,E11,E21},Ac3}; +modify_anno1({bin_element,A,E1,E2,TSL}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{bin_element,A1,E11,E21, TSL},Ac3}; +modify_anno1({Tag,A,E1,E2,E3}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {{Tag,A1,E11,E21,E31},Ac4}; +modify_anno1({Tag,A,E1,E2,E3,E4}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {E41,Ac5} = modify_anno1(E4, Ac4, Mf), + {{Tag,A1,E11,E21,E31,E41},Ac5}; +modify_anno1([H|T], Ac, Mf) -> + {H1,Ac1} = modify_anno1(H, Ac, Mf), + {T1,Ac2} = modify_anno1(T, Ac1, Mf), + {[H1|T1],Ac2}; +modify_anno1([], Ac, _Mf) -> {[],Ac}; +modify_anno1(E, Ac, _Mf) when not is_tuple(E), not is_list(E) -> {E,Ac}. + %% vim: ft=erlang diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 469ce544c7..623a29f923 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 +46,23 @@ -record(options, {hook, encoding, opts}). +%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(TEST(T), + %% Assumes that erl_anno has been compiled with DEBUG=true. + %% erl_pp does not use the annoations, but test it anyway. + %% Note: hooks are not handled. + _ = try + erl_parse:map_anno(fun(A) when is_list(A) -> A end, T) + catch + _:_ -> + erlang:error(badarg, [T]) + end). +-else. +-define(TEST(T), ok). +-endif. + %%% %%% Exported functions %%% @@ -61,6 +78,7 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> + ?TEST(Thing), State = state(Options), frmt(lform(Thing, options(Options), State), State). @@ -75,6 +93,7 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> + ?TEST(Thing), State = state(Options), frmt(lattribute(Thing, options(Options), State), State). @@ -89,6 +108,7 @@ function(F) -> Options :: options()). function(F, Options) -> + ?TEST(F), frmt(lfunction(F, options(Options)), state(Options)). -spec(guard(Guard) -> io_lib:chars() when @@ -102,6 +122,7 @@ guard(Gs) -> Options :: options()). guard(Gs, Options) -> + ?TEST(Gs), frmt(lguard(Gs, options(Options)), state(Options)). -spec(exprs(Expressions) -> io_lib:chars() when @@ -123,12 +144,14 @@ exprs(Es, Options) -> Options :: options()). exprs(Es, I, Options) -> + ?TEST(Es), frmt({seq,[],[],[$,],lexprs(Es, options(Options))}, I, state(Options)). -spec(expr(Expression) -> io_lib:chars() when Expression :: erl_parse:abstract_expr()). expr(E) -> + ?TEST(E), frmt(lexpr(E, 0, options(none)), state(none)). -spec(expr(Expression, Options) -> io_lib:chars() when @@ -136,6 +159,7 @@ expr(E) -> Options :: options()). expr(E, Options) -> + ?TEST(E), frmt(lexpr(E, 0, options(Options)), state(Options)). -spec(expr(Expression, Indent, Options) -> io_lib:chars() when @@ -144,6 +168,7 @@ expr(E, Options) -> Options :: options()). expr(E, I, Options) -> + ?TEST(E), frmt(lexpr(E, 0, options(Options)), I, state(Options)). -spec(expr(Expression, Indent, Precedence, Options) -> io_lib:chars() when @@ -153,6 +178,7 @@ expr(E, I, Options) -> Options :: options()). expr(E, I, P, Options) -> + ?TEST(E), frmt(lexpr(E, P, options(Options)), I, state(Options)). %%% @@ -213,24 +239,25 @@ lattribute({attribute,_Line,Name,Arg}, Opts, State) -> [lattribute(Name, Arg, Opts, State),leaf(".\n")]. lattribute(module, {M,Vs}, _Opts, _State) -> - attr("module",[{var,0,pname(M)}, - foldr(fun(V, C) -> {cons,0,{var,0,V},C} - end, {nil,0}, Vs)]); + A = a0(), + attr("module",[{var,A,pname(M)}, + foldr(fun(V, C) -> {cons,A,{var,A,V},C} + end, {nil,A}, Vs)]); lattribute(module, M, _Opts, _State) -> - attr("module", [{var,0,pname(M)}]); + attr("module", [{var,a0(),pname(M)}]); lattribute(export, Falist, _Opts, _State) -> - call({var,0,"-export"}, [falist(Falist)], 0, options(none)); + call({var,a0(),"-export"}, [falist(Falist)], 0, options(none)); lattribute(import, Name, _Opts, _State) when is_list(Name) -> - attr("import", [{var,0,pname(Name)}]); + attr("import", [{var,a0(),pname(Name)}]); lattribute(import, {From,Falist}, _Opts, _State) -> - attr("import",[{var,0,pname(From)},falist(Falist)]); + attr("import",[{var,a0(),pname(From)},falist(Falist)]); lattribute(optional_callbacks, Falist, Opts, _State) -> ArgL = try falist(Falist) catch _:_ -> abstract(Falist, Opts) end, - call({var,0,"-optional_callbacks"}, [ArgL], 0, options(none)); + call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none)); lattribute(file, {Name,Line}, _Opts, State) -> - attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); + attr("file", [{var,a0(),(State#pp.string_fun)(Name)},{integer,a0(),Line}]); lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; @@ -242,7 +269,7 @@ abstract(Arg, #options{encoding = Encoding}) -> typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), - typed(call({atom,0,TypeName}, Args, 0, options(none)), Type)}. + typed(call({atom,a0(),TypeName}, Args, 0, options(none)), Type)}. ltype({ann_type,_Line,[V,T]}) -> typed(lexpr(V, options(none)), T); @@ -384,7 +411,7 @@ ltypes(Ts, F) -> [F(T) || T <- Ts]. attr(Name, Args) -> - call({var,0,format("-~s", [Name])}, Args, 0, options(none)). + call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)). pname(['' | As]) -> [$. | pname(As)]; @@ -396,9 +423,10 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - {nil,0}; + {nil,a0()}; falist([{Name,Arity}|Falist]) -> - {cons,0,{var,0,format("~w/~w", [Name,Arity])},falist(Falist)}. + A = a0(), + {cons,A,{var,A,format("~w/~w", [Name,Arity])},falist(Falist)}. lfunction({function,_Line,Name,_Arity,Cs}, Opts) -> Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Opts, Cs), @@ -1111,6 +1139,9 @@ write_char(C, PP) -> %% Utilities %% +a0() -> + erl_anno:new(0). + chars_size([C | Es]) when is_integer(C) -> 1 + chars_size(Es); chars_size([E | Es]) -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 4960a86760..5e7cc5f6d6 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -55,6 +55,15 @@ token_info/1,token_info/2, attributes_info/1,attributes_info/2,set_attribute/3]). +-export([column/1,end_location/1,line/1,location/1,text/1, + category/1,symbol/1]). + +-deprecated([{attributes_info, 1, next_major_release}, + {attributes_info, 2, next_major_release}, + {set_attribute, 3, next_major_release}, + {token_info, 1, next_major_release}, + {token_info, 2, next_major_release}]). + %%% Private -export([continuation_location/1]). @@ -78,9 +87,9 @@ -define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). --type line() :: integer(). --type location() :: line() | {line(),column()}. +-type column() :: pos_integer(). % Deprecated +-type line() :: integer(). % Deprecated +-type location() :: line() | {line(),column()}. % Deprecated -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. @@ -197,6 +206,56 @@ continuation_location({erl_scan_continuation,_,no_col,_,Line,_,_,_}) -> continuation_location({erl_scan_continuation,_,Col,_,Line,_,_,_}) -> {Line,Col}. +-spec column(Token) -> erl_anno:column() | 'undefined' when + Token :: token(). + +column(Token) -> + erl_anno:column(element(2, Token)). + +-spec end_location(Token) -> erl_anno:location() | 'undefined' when + Token :: token(). + +end_location(Token) -> + erl_anno:end_location(element(2, Token)). + +-spec line(Token) -> erl_anno:line() when + Token :: token(). + +line(Token) -> + erl_anno:line(element(2, Token)). + +-spec location(Token) -> erl_anno:location() when + Token :: token(). + +location(Token) -> + erl_anno:location(element(2, Token)). + +-spec text(Token) -> erl_anno:text() | 'undefined' when + Token :: token(). + +text(Token) -> + erl_anno:text(element(2, Token)). + +-spec category(Token) -> category() when + Token :: token(). + +category({Category,_Anno}) -> + Category; +category({Category,_Anno,_Symbol}) -> + Category; +category(T) -> + erlang:error(badarg, [T]). + +-spec symbol(Token) -> symbol() when + Token :: token(). + +symbol({Category,_Anno}) -> + Category; +symbol({_Category,_Anno,Symbol}) -> + Symbol; +symbol(T) -> + erlang:error(badarg, [T]). + -type attribute_item() :: 'column' | 'length' | 'line' | 'location' | 'text'. -type info_location() :: location() | term(). @@ -276,7 +335,17 @@ attributes_info({Line,Column}, column=Item) when ?ALINE(Line), attributes_info(Line, column) when ?ALINE(Line) -> undefined; attributes_info(Attrs, column=Item) -> - attr_info(Attrs, Item); + case attr_info(Attrs, Item) of + undefined -> + case erl_anno:column(Attrs) of + undefined -> + undefined; + Column -> + {Item,Column} + end; + T -> + T + end; attributes_info(Attrs, length=Item) -> case attributes_info(Attrs, text) of undefined -> @@ -290,14 +359,26 @@ attributes_info({Line,Column}, line=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Line}; attributes_info(Attrs, line=Item) -> - attr_info(Attrs, Item); + case attr_info(Attrs, Item) of + undefined -> + case attr_info(Attrs, location) of + {location,{Line,_Column}} -> + {Item,Line}; + {location,Line} -> + {Item,Line}; + undefined -> + undefined + end; + T -> + T + end; attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Location}; attributes_info(Line, location=Item) when ?ALINE(Line) -> {Item,Line}; attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), % assume line is present + {line,Line} = attributes_info(Attrs, line), case attributes_info(Attrs, column) of undefined -> %% If set_attribute() has assigned a term such as {17,42} @@ -419,12 +500,28 @@ set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> [{line,Ln},{column,Column}] end; set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - {line,Line} = lists:keyfind(Tag, 1, Attrs), - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As + case lists:keyfind(Tag, 1, Attrs) of + {line,Line} -> + case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of + [{line,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end; + false -> + {location, Location} = lists:keyfind(location, 1, Attrs), + Ln = case Location of + {Line,Column} when ?ALINE(Line), ?COLUMN(Column) -> + {Fun(Line),Column}; + _ -> + Fun(Location) + end, + case lists:keyreplace(location, 1, Attrs, {location,Ln}) of + [{location,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end end; set_attr(T1, T2, T3) -> erlang:error(badarg, [T1,T2,T3]). @@ -708,17 +805,17 @@ scan_name(Cs, Ncs) -> -define(STR(St, S), if St#erl_scan.text -> S; true -> [] end). scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), - {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line+1,new_column(Col, 1)}; scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> - Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 2)}; scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot(Cs, St, Line, Col, Toks, Ncs) -> tok2(Cs, St, Line, Col, Toks, Ncs, '.', 1). @@ -773,12 +870,12 @@ scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> %% stop anyway, nothing is gained by not collecting all white spaces. scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, Toks0, Ncs) -> - Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], + Toks = [{white_space,anno(Line),lists:reverse(Ncs)}|Toks0], scan_newline(Cs, St, Line+1, Col, Toks); scan_nl_white_space([$\n|Cs], St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan_newline(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]); scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); @@ -786,19 +883,20 @@ scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); + Anno = anno(Line), + scan1(Cs, St, Line+1, Col, [{white_space,Anno,lists:reverse(Ncs)}|Toks]); scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _N, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); + scan1(Cs, St, Line+1, Col, [{white_space,anno(Line),Ncs}|Toks]); newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Attrs,Ncs}|Toks]). + Anno = anno(Line, Col, St, Ncs), + scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Anno,Ncs}|Toks]). scan_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 16 -> scan_spcs(Cs, St, Line, Col, Toks, N+1); @@ -847,20 +945,20 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> {eof,Ncol} -> scan_error(char, Line, Col, Line, Ncol, eof); {nl,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line+1, Ncol, Ntoks); {Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; scan_char([$\n=C|Cs], St, Line, Col, Toks) -> - Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), - scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Anno,C}|Toks]); scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) -> - Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), - scan1(Cs, St, Line, incr_column(Col, 2), [{char,Attrs,C}|Toks]); + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line, incr_column(Col, 2), [{char,Anno,C}|Toks]); scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof); scan_char([], _St, Line, Col, Toks) -> @@ -879,8 +977,8 @@ scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" {Ncs,Nline,Ncol,Nstr,Nwcs} -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]) + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{string,Anno,Nwcs}|Toks]) end. scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> @@ -896,8 +994,8 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> {Ncs,Nline,Ncol,Nstr,Nwcs} -> case catch list_to_atom(Nwcs) of A when is_atom(A) -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{atom,Attrs,A}|Toks]); + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{atom,Anno,A}|Toks]); _ -> scan_error({illegal,atom}, Line0, Col0, Nline, Ncol, Ncs) end @@ -1173,28 +1271,28 @@ scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Anno}|Toks]). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P, _N) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P, N) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, N), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, N), [{P,Anno}|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _S, Sym) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, length(String)), [Token|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _String, Sym, _Length) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym, Length) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, Length), [Token|Toks]). scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> @@ -1205,23 +1303,28 @@ scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> scan_error(Error, ErrorLoc, EndLoc, Rest) -> {{error,{ErrorLoc,?MODULE,Error},EndLoc},Rest}. --compile({inline,[attributes/4]}). +-compile({inline,[anno/4]}). -attributes(Line, no_col, #erl_scan{text = false}, _String) -> - Line; -attributes(Line, no_col, #erl_scan{text = true}, String) -> - [{line,Line},{text,String}]; -attributes(Line, Col, #erl_scan{text = false}, _String) -> - {Line,Col}; -attributes(Line, Col, #erl_scan{text = true}, String) -> - [{line,Line},{column,Col},{text,String}]. +anno(Line, no_col, #erl_scan{text = false}, _String) -> + anno(Line); +anno(Line, no_col, #erl_scan{text = true}, String) -> + Anno = anno(Line), + erl_anno:set_text(String, Anno); +anno(Line, Col, #erl_scan{text = false}, _String) -> + anno({Line, Col}); +anno(Line, Col, #erl_scan{text = true}, String) -> + Anno = anno({Line, Col}), + erl_anno:set_text(String, Anno). location(Line, no_col) -> Line; location(Line, Col) when is_integer(Col) -> {Line,Col}. --compile({inline,[incr_column/2,new_column/2]}). +-compile({inline,[anno/1,incr_column/2,new_column/2]}). + +anno(Location) -> + erl_anno:new(Location). incr_column(no_col=Col, _N) -> Col; diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 90e1f3a8d6..f0827009a5 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -620,12 +620,13 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {ok, {attribute,_, module, M} = Form} -> epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]); {ok, _} -> - ModForm = {attribute,1,module, Module}, + ModForm = {attribute,a1(),module, Module}, epp_parse_file2(Epp, S2, [ModForm, FileForm], OptModRes); {error, _} -> epp_parse_file2(Epp, S2, [FileForm], OptModRes); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = [FileForm, Eof]} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = [FileForm, {eof, Anno}]} end, ok = epp:close(Epp), ok = file:close(Fd), @@ -644,7 +645,7 @@ check_source(S, CheckOnly) -> %% Optionally add export of main/1 Forms2 = case ExpMain of - false -> [{attribute,0,export, [{main,1}]} | Forms]; + false -> [{attribute, a0(), export, [{main,1}]} | Forms]; true -> Forms end, Forms3 = [FileForm2, ModForm2 | Forms2], @@ -722,8 +723,9 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> io:format("~ts:~w: ~ts\n", [S#state.file,Ln,Mod:format_error(Args)]), epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = lists:reverse([Eof | Forms])} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = lists:reverse([{eof, Anno} | Forms])} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -778,7 +780,8 @@ interpret(Forms, HasRecs, File, Args) -> end, Dict = parse_to_dict(Forms2), ArgsA = erl_parse:abstract(Args, 0), - Call = {call,0,{atom,0,main},[ArgsA]}, + Anno = a0(), + Call = {call,Anno,{atom,Anno,main},[ArgsA]}, try _ = erl_eval:expr(Call, erl_eval:new_bindings(), @@ -890,6 +893,15 @@ enc() -> Enc -> [Enc] end. +a0() -> + anno(0). + +a1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). + fatal(Str) -> throw(Str). 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/io.erl b/lib/stdlib/src/io.erl index b9ace2f442..0b59546dc4 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -45,7 +45,7 @@ %% ErrorDescription is whatever the I/O-server sends. -type server_no_data() :: {'error', ErrorDescription :: term()} | 'eof'. --type location() :: erl_scan:location(). +-type location() :: erl_anno:location(). %%------------------------------------------------------------------------- diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 7b6f4e5b50..6e3723bb98 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -822,9 +822,10 @@ th(T,B,OB) when is_tuple(T) -> th(Nonstruct,B,_OB) -> {Nonstruct,B}. -warn_var_clash(Line,Name,OuterBound) -> +warn_var_clash(Anno,Name,OuterBound) -> case gb_sets:is_member(Name,OuterBound) of true -> + Line = erl_anno:line(Anno), add_warning(Line,{?WARN_SHADOW_VAR,Name}); _ -> ok diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 0fb6974426..24721da187 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -18,7 +18,7 @@ %% -module(otp_internal). --export([obsolete/3]). +-export([obsolete/3, obsolete_type/3]). %%---------------------------------------------------------------------- @@ -26,7 +26,7 @@ -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). --spec obsolete(atom(), atom(), byte()) -> +-spec obsolete(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. obsolete(Module, Name, Arity) -> @@ -595,6 +595,39 @@ obsolete_1(core_lib, is_literal_list, 1) -> " instead"}; obsolete_1(core_lib, literal_value, 1) -> {deprecated,{core_lib,concrete,1}}; +obsolete_1(erl_scan, set_attribute, 3) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; +obsolete_1(erl_scan, attributes_info, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, attributes_info, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_parse, set_line, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; +obsolete_1(erl_parse, get_attributes, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_parse, get_attribute, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_lint, modify_line, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"}; obsolete_1(ssl, negotiated_next_protocol, 1) -> {deprecated,{ssl,negotiated_protocol,1}}; @@ -644,3 +677,30 @@ is_snmp_agent_function(add_agent_caps, 2) -> true; is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. + +-spec obsolete_type(module(), atom(), arity()) -> + 'no' | {tag(), string()} | {tag(), mfas(), release()}. + +obsolete_type(Module, Name, NumberOfVariables) -> + case obsolete_type_1(Module, Name, NumberOfVariables) of +%% {deprecated=Tag,{_,_,_}=Replacement} -> +%% {Tag,Replacement,"in a future release"}; + {_,String}=Ret when is_list(String) -> + Ret; +%% {_,_,_}=Ret -> +%% Ret; + no -> + no + end. + +obsolete_type_1(erl_scan,column,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:column() instead"}; +obsolete_type_1(erl_scan,line,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:line() instead"}; +obsolete_type_1(erl_scan,location,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:location() instead"}; +obsolete_type_1(_,_,_) -> + no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 5b19ee6190..ad8aafbb1a 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.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 @@ -1006,7 +1006,7 @@ listify(T) -> -record(simple_qlc, {p, % atom(), pattern variable le, - line, + line :: erl_anno:anno(), init_value, optz % #optz }). @@ -1148,15 +1148,18 @@ abstract(Info, true=_Flat, NElements, Depth) -> [{match,_,Expr,Q}] -> Q; [{match,_,Expr,Q} | Body] -> - {block, 0, lists:reverse(Body, [Q])}; + {block, anno0(), lists:reverse(Body, [Q])}; _ -> - {block, 0, lists:reverse(Body0, [Expr])} + {block, anno0(), lists:reverse(Body0, [Expr])} end. -abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> +abstract(Info, NElements, Depth) -> + abstract1(Info, NElements, Depth, anno1()). + +abstract1({qlc, E0, Qs0, Opt}, NElements, Depth, A) -> Qs = lists:map(fun({generate, P, LE}) -> - {generate, 1, binary_to_term(P), - abstract(LE, NElements, Depth)}; + {generate, A, binary_to_term(P), + abstract1(LE, NElements, Depth, A)}; (F) -> binary_to_term(F) end, Qs0), @@ -1165,12 +1168,12 @@ abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> [] -> []; _ -> [abstract_term(Opt, 1)] end, - ?QLC_Q(1, 1, 1, 1, {lc,1,E,Qs}, Os); -abstract({table, {M, F, As0}}, _NElements, _Depth) + ?QLC_Q(A, A, A, A, {lc,A,E,Qs}, Os); +abstract1({table, {M, F, As0}}, _NElements, _Depth, Anno) when is_atom(M), is_atom(F), is_list(As0) -> As = [abstract_term(A, 1) || A <- As0], - {call, 1, {remote, 1, {atom, 1, M}, {atom, 1, F}}, As}; -abstract({table, TableDesc}, _NElements, _Depth) -> + {call, Anno, {remote, Anno, {atom, Anno, M}, {atom, Anno, F}}, As}; +abstract1({table, TableDesc}, _NElements, _Depth, _A) -> case io_lib:deep_char_list(TableDesc) of true -> {ok, Tokens, _} = erl_scan:string(lists:flatten(TableDesc++".")), @@ -1179,27 +1182,28 @@ abstract({table, TableDesc}, _NElements, _Depth) -> false -> % abstract expression TableDesc end; -abstract({append, Infos}, NElements, Depth) -> +abstract1({append, Infos}, NElements, Depth, A) -> As = lists:foldr(fun(Info, As0) -> - {cons,1,abstract(Info, NElements, Depth),As0} - end, {nil, 1}, Infos), - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, append}}, [As]}; -abstract({sort, Info, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, sort}}, - [abstract(Info, NElements, Depth), abstract_term(SortOptions, 1)]}; -abstract({keysort, Info, Kp, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, keysort}}, - [abstract_term(Kp, 1), abstract(Info, NElements, Depth), + {cons,A,abstract1(Info, NElements, Depth, A), + As0} + end, {nil, A}, Infos), + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, append}}, [As]}; +abstract1({sort, Info, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, sort}}, + [abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; +abstract1({keysort, Info, Kp, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, keysort}}, + [abstract_term(Kp, 1), abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; -abstract({list,L,MS}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_run}}, - [abstract(L, NElements, Depth), - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_compile}}, +abstract1({list,L,MS}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_run}}, + [abstract1(L, NElements, Depth, A), + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_compile}}, [abstract_term(depth(MS, Depth), 1)]}]}; -abstract({list, L}, NElements, Depth) when NElements =:= infinity; - NElements >= length(L) -> +abstract1({list, L}, NElements, Depth, _A) when NElements =:= infinity; + NElements >= length(L) -> abstract_term(depth(L, Depth), 1); -abstract({list, L}, NElements, Depth) -> +abstract1({list, L}, NElements, Depth, _A) -> abstract_term(depth(lists:sublist(L, NElements), Depth) ++ '...', 1). depth(List, infinity) -> @@ -1251,14 +1255,14 @@ abstract_term(Term) -> abstract_term(Term, 0). abstract_term(Term, Line) -> - abstr_term(Term, Line). + abstr_term(Term, anno(Line)). abstr_term(Tuple, Line) when is_tuple(Tuple) -> {tuple,Line,[abstr_term(E, Line) || E <- tuple_to_list(Tuple)]}; abstr_term([_ | _]=L, Line) -> case io_lib:char_list(L) of true -> - erl_parse:abstract(L, Line); + erl_parse:abstract(L, erl_anno:line(Line)); false -> abstr_list(L, Line) end; @@ -1285,7 +1289,7 @@ abstr_term(Fun, Line) when is_function(Fun) -> abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) -> {special, Line, lists:flatten(io_lib:write(PPR))}; abstr_term(Simple, Line) -> - erl_parse:abstract(Simple, Line). + erl_parse:abstract(Simple, erl_anno:line(Line)). abstr_list([H | T], Line) -> {cons, Line, abstr_term(H, Line), abstr_list(T, Line)}; @@ -1519,7 +1523,7 @@ join_info(Join, QInfo, Qdata, Code) -> %% Only compared constants (==). [Cs1_0, Cs2_0] end, - L = 0, + L = anno0(), G1_0 = {var,L,'G1'}, G2_0 = {var,L,'G2'}, JP = element(JQNum + 1, Code), %% Create code for wh1 and wh2 in #join{}: @@ -1571,7 +1575,7 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> {P, P}; _ -> {PV, _} = aux_name1('P', 0, abstract_vars(P)), - L = 0, + L = erl_anno:new(0), V = {var, L, PV}, {V, {match, L, V, P}} end, @@ -1579,19 +1583,20 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> LEI = {generate, term_to_binary(M), LEInfo}, TP = term_to_binary(G), CFs = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},EPV]}, - F = list2op([{op,0,Op,abstract_term(Con),Call} - || {Con,Op} <- ConstOps], 'or'), + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col},EPV]}, + F = list2op([{op,A,Op,abstract_term(Con),Call} + || {Con,Op} <- ConstOps], 'or', A), term_to_binary(F) end || {Col,ConstOps} <- ExtraConstants], {{I,G}, [{generate, TP, {qlc, DQP, [LEI | CFs], []}}]} end. -list2op([E], _Op) -> +list2op([E], _Op, _Anno) -> E; -list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. +list2op([E | Es], Op, Anno) -> + {op,Anno,Op,E,list2op(Es, Op, Anno)}. join_lookup_info(QNum, QInfo, G) -> {generate, _, LEInfo}=I = lists:nth(QNum, QInfo), @@ -1704,7 +1709,7 @@ eval_le(LE_fun, GOpt) -> prep_qlc_lc({simple_v1, PVar, LE_fun, L}, Opt, GOpt, _H) -> check_lookup_option(Opt, false), - prep_simple_qlc(PVar, L, eval_le(LE_fun, GOpt), Opt); + prep_simple_qlc(PVar, anno(L), eval_le(LE_fun, GOpt), Opt); prep_qlc_lc({qlc_v1, QFun, CodeF, Qdata0, QOpt}, Opt, GOpt, _H) -> F = fun(?qual_data(_QNum, _GoI, _SI, fil)=QualData, ModGens) -> {QualData, ModGens}; @@ -1821,7 +1826,7 @@ may_create_simple(#qlc_opt{unique = Unique, cache = Cache} = Opt, if Unique and not IsUnique; (Cache =/= false) and not IsCached -> - prep_simple_qlc(?SIMPLE_QVAR, 1, Prep, Opt); + prep_simple_qlc(?SIMPLE_QVAR, anno(1), Prep, Opt); true -> Prep end. @@ -3772,6 +3777,15 @@ grd(Fun, Arg) -> false end. +anno0() -> + anno(0). + +anno1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). + family(L) -> sofs:to_external(sofs:relation_to_family(sofs:relation(L))). diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index b6bb758dfb..a4d2157b35 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. 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 @@ -39,7 +39,12 @@ opt % #qlc_opt }). --record(state, {imp, maxargs, records, xwarnings = []}). +-record(state, {imp, + maxargs, + records, + xwarnings = [], + intro_vars, + node_info}). %-define(debug, true). @@ -66,37 +71,49 @@ Options :: [Option], Option :: type_checker | compile:option()). -parse_transform(Forms, Options) -> +parse_transform(Forms0, Options) -> ?DEBUG("qlc Parse Transform~n", []), - State = #state{imp = is_qlc_q_imported(Forms), - maxargs = ?COMPILE_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, - case called_from_type_checker(Options) of - true -> - %% The returned value should conform to the types, but - %% need not evaluate to anything meaningful. - L = 0, - {tuple,_,Fs0} = abstr(#qlc_lc{}, L), - F = fun(_Id, LC, A) -> - Init = simple(L, 'V', LC, L), - {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} - end, - {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), - Forms1; - false -> - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],Warnings} -> - {NewForms, State1} = transform(FormsNoShadows, State), - ExtraWs = State1#state.xwarnings, - {[],WForms} = no_duplicates(NewForms, [], Warnings, - ExtraWs, Options), - WForms ++ NewForms; - {E0,Errors,Warnings} -> - {EForms,WForms} = no_duplicates(Forms, E0++Errors, - Warnings, [], Options), - EForms ++ WForms ++ Forms - end + Imported = is_qlc_q_imported(Forms0), + {Forms, FormsNoShadows, State} = initiate(Forms0, Imported), + NodeInfo = State#state.node_info, + try + case called_from_type_checker(Options) of + true -> + %% The returned value should conform to the types, but + %% need not evaluate to anything meaningful. + L = anno0(), + {tuple,_,Fs0} = abstr(#qlc_lc{}, L), + F = fun(_Id, LC, A) -> + Init = simple(L, 'V', LC, L), + {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} + end, + {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), + Forms1; + false -> + case + compile_messages(Forms, FormsNoShadows, Options, State) + of + {[],Warnings} -> + ?DEBUG("node info1 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {NewForms, State1} = + transform(FormsNoShadows, State), + ExtraWs = State1#state.xwarnings, + {[],WForms} = no_duplicates(NewForms, [], Warnings, + ExtraWs, Options), + (restore_locations(WForms, State) ++ + restore_anno(NewForms, NodeInfo)); + {Errors,Warnings} -> + ?DEBUG("node info2 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {EForms,WForms} = no_duplicates(FormsNoShadows, Errors, + Warnings, [], + Options), + restore_locations(EForms ++ WForms, State) ++ Forms0 + end + end + after + true = ets:delete(NodeInfo) end. -spec(transform_from_evaluator(LC, Bs) -> Expr when @@ -124,30 +141,78 @@ called_from_type_checker(Options) -> lists:member(type_checker, Options). transform_expression(LC, Bs0, WithLintErrors) -> - L = 1, + L = anno1(), As = [{var,L,V} || {V,_Val} <- Bs0], Ar = length(As), F = {function,L,bar,Ar,[{clause,L,As,[],[?QLC_Q(L, L, L, L, LC, [])]}]}, - Forms = [{attribute,L,file,{"foo",L}}, - {attribute,L,module,foo}, F], - State = #state{imp = false, - maxargs = ?EVAL_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, + Forms0 = [{attribute,L,file,{"foo",L}}, + {attribute,L,module,foo}, F], + {Forms, FormsNoShadows, State} = initiate(Forms0, false), + NodeInfo = State#state.node_info, Options = [], - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],_Warnings} -> - {NewForms,_State1} = transform(FormsNoShadows, State), - {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = - lists:last(NewForms), - {ok,NF}; - {E0,Errors,_Warnings} when WithLintErrors -> - {not_ok,mforms(error, E0 ++ Errors)}; - {E0,Errors0,_Warnings} -> - [{error,Reason} | _] = mforms(error, E0++Errors0), - {not_ok, {error, ?APIMOD, Reason}} + try compile_messages(Forms, FormsNoShadows, Options, State) of + {Errors0,_Warnings} -> + case restore_locations(Errors0, State) of + [] -> + {NewForms,_State1} = transform(FormsNoShadows, State), + NewForms1 = restore_anno(NewForms, NodeInfo), + {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = + lists:last(NewForms1), + {ok,NF}; + Errors when WithLintErrors -> + {not_ok,mforms(error, Errors)}; + Errors -> + [{error,Reason} | _] = mforms(error, Errors), + {not_ok, {error, ?APIMOD, Reason}} + end + after + true = ets:delete(NodeInfo) end. +-ifdef(DEBUG). +-define(ILIM, 0). +-else. +-define(ILIM, 255). +-endif. + +initiate(Forms0, Imported) -> + NodeInfo = ets:new(?APIMOD, []), + true = ets:insert(NodeInfo, {var_n, ?ILIM}), + exclude_integers_from_unique_line_numbers(Forms0, NodeInfo), + ?DEBUG("node info0 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + State0 = #state{imp = Imported, + maxargs = ?EVAL_MAX_NUM_OF_ARGS, + records = record_attributes(Forms0), + node_info = NodeInfo}, + Forms = save_anno(Forms0, NodeInfo), + FormsNoShadows = no_shadows(Forms, State0), + IntroVars = intro_variables(FormsNoShadows, State0), + State = State0#state{intro_vars = IntroVars}, + {Forms, FormsNoShadows, State}. + +%% Make sure restore_locations() does not confuse integers with (the +%% unique) line numbers. +exclude_integers_from_unique_line_numbers(Forms, NodeInfo) -> + Integers = find_integers(Forms), + lists:foreach(fun(I) -> ets:insert(NodeInfo, {I}) end, Integers). + +find_integers(Forms) -> + F = fun(A) -> + Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms), + ordsets:from_list(integers(Fs1, [])) + end, + ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))). + +integers([E | Es], L) -> + integers(Es, integers(E, L)); +integers(T, L) when is_tuple(T) -> + integers(tuple_to_list(T), L); +integers(I, L) when is_integer(I), I > ?ILIM -> + [I | L]; +integers(_, L) -> + L. + -define(I(I), {integer, L, I}). -define(A(A), {atom, L, A}). -define(V(V), {var, L, V}). @@ -164,9 +229,15 @@ mforms(Tag, L) -> %% Avoid duplicated lint warnings and lint errors. Care has been taken %% not to introduce unused variables in the transformed code. %% -no_duplicates(Forms, Errors, Warnings0, ExtraWarnings, Options) -> +no_duplicates(Forms, Errors, Warnings0, ExtraWarnings0, Options) -> %% Some mistakes such as "{X} =:= {}" are found by strong %% validation as well as by qlc. Prefer the warnings from qlc: + %% The Compiler and qlc do not agree on the location of errors. + %% For now, qlc's messages about failing patterns and filters + %% are ignored. + ExtraWarnings = [W || W={_File,[{_,qlc,Tag}]} <- + ExtraWarnings0, + not lists:member(Tag, [nomatch_pattern,nomatch_filter])], Warnings1 = mforms(Warnings0) -- ([{File,[{L,v3_core,nomatch}]} || {File,[{L,qlc,M}]} <- mforms(ExtraWarnings), @@ -185,13 +256,22 @@ mforms(L) -> lists:sort([{File,[M]} || {File,Ms} <- L, M <- Ms]). mforms2(Tag, L) -> - Line = 0, + Line = anno0(), ML = lists:flatmap(fun({File,Ms}) -> - [[{attribute,Line,file,{File,Line}}, {Tag,M}] || + [[{attribute,Line,file,{File,0}}, {Tag,M}] || M <- Ms] end, lists:sort(L)), lists:flatten(lists:sort(ML)). +restore_locations([T | Ts], State) -> + [restore_locations(T, State) | restore_locations(Ts, State)]; +restore_locations(T, State) when is_tuple(T) -> + list_to_tuple(restore_locations(tuple_to_list(T), State)); +restore_locations(I, State) when I > ?ILIM -> + restore_loc(I, State); +restore_locations(T, _State) -> + T. + is_qlc_q_imported(Forms) -> [[] || {attribute,_,import,{?APIMOD,FAs}} <- Forms, {?Q,1} <- FAs] =/= []. @@ -212,13 +292,20 @@ compile_messages(Forms, FormsNoShadows, Options, State) -> (_QId, Q, GA, A) -> {Q,GA,A} end, - {_,BGens} = qual_fold(BGenF, [], [], FormsNoShadows, State), + {_,BGens} = qual_fold(BGenF, [], [], Forms, State), GenForm = used_genvar_check(FormsNoShadows, State), ?DEBUG("GenForm = ~ts~n", [catch erl_pp:form(GenForm)]), - WarnFun = fun(Id, LC, A) -> {tag_lines(LC, get_lcid_no(Id)), A} end, + {GEs,_} = compile_forms([GenForm], Options), + UsedGenVarMsgs = used_genvar_messages(GEs, State), + NodeInfo = State#state.node_info, + WarnFun = fun(_Id, LC, A) -> {lc_nodes(LC, NodeInfo), A} end, {WForms,ok} = qlc_mapfold(WarnFun, ok, Forms, State), - {Es,Ws} = compile_forms(WForms ++ [GenForm], Options), - {badarg(Forms, State),tagged_messages(Es)++BGens,tagged_messages(Ws)}. + {Es,Ws} = compile_forms(WForms, Options), + LcEs = lc_messages(Es, NodeInfo), + LcWs = lc_messages(Ws, NodeInfo), + Errors = badarg(Forms, State) ++ UsedGenVarMsgs++LcEs++BGens, + Warnings = LcWs, + {Errors,Warnings}. badarg(Forms, State) -> F = fun(_Id, {lc,_L,_E,_Qs}=LC, Es) -> @@ -230,54 +317,39 @@ badarg(Forms, State) -> {_,E0} = qlc_mapfold(F, [], Forms, State), E0. -tag_lines(E, No) -> - map_lines(fun(Id) -> - case is_lcid(Id) of - true -> Id; - false -> make_lcid(Id, No) - end - end, E). - -map_lines(F, E) -> - erl_lint:modify_line(E, F). - -tagged_messages(MsL) -> - [{File, - [{Loc,Mod,untag(T)} || {Loc0,Mod,T} <- Ms, - {true,Loc} <- [tloc(Loc0)]]} - || {File,Ms} <- MsL] - ++ +lc_nodes(E, NodeInfo) -> + erl_parse:map_anno(fun(Anno) -> + N = erl_anno:line(Anno), + [{N, Data}] = ets:lookup(NodeInfo, N), + NData = Data#{inside_lc => true}, + true = ets:insert(NodeInfo, {N, NData}), + Anno + end, E). + +used_genvar_messages(MsL, S) -> [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]} - || {_, Ms} <- MsL, + || {_, Ms} <- MsL, {XLoc,erl_lint,{unbound_var,_}} <- Ms, - {Loc,File,V} <- [extra(XLoc)]]. - -tloc({Id,Column}) -> - {IsLcid,T} = tloc(Id), - {IsLcid,{T,Column}}; -tloc(Id) -> - IsLcid = is_lcid(Id), - {IsLcid,case IsLcid of - true -> get_lcid_line(Id); - false -> any - end}. - -extra({extra,Line,File,V}) -> - {Line,File,V}; -extra({Line,Column}) -> - case extra(Line) of - {L,File,V} -> {{L,Column},File,V}; - Else -> Else - end; -extra(Else) -> - Else. - -untag([E | Es]) -> [untag(E) | untag(Es)]; -untag(T) when is_tuple(T) -> list_to_tuple(untag(tuple_to_list(T))); -untag(E) -> - case is_lcid(E) of - true -> get_lcid_line(E); - false -> E + {Loc,File,V} <- [genvar_pos(XLoc, S)]]. + +lc_messages(MsL, NodeInfo) -> + [{File,[{Loc,Mod,T} || {Loc,Mod,T} <- Ms, lc_loc(Loc, NodeInfo)]} || + {File,Ms} <- MsL]. + +lc_loc(N, NodeInfo) -> + case ets:lookup(NodeInfo, N) of + [{N, #{inside_lc := true}}] -> + true; + [{N, _}] -> + false + end. + +genvar_pos(Location, S) -> + case ets:lookup(S#state.node_info, Location) of + [{Location, #{genvar_pos := Pos}}] -> + Pos; + [] -> + Location end. %% -> [{Qid,[variable()]}]. @@ -293,6 +365,7 @@ untag(E) -> %% variables (unless they are unsafe). %% intro_variables(FormsNoShadows, State) -> + NodeInfo = State#state.node_info, Fun = fun(QId, {T,_L,P0,_E0}=Q, {GVs,QIds}, Foo) when T =:= b_generate; T =:= generate -> PVs = qlc:var_ufold(fun({var,_,V}) -> {QId,V} end, P0), @@ -302,10 +375,11 @@ intro_variables(FormsNoShadows, State) -> %% where E is an LC expression consisting of a %% template mentioning all variables occurring in F. Vs = ordsets:to_list(qlc:vars(Filter0)), - Id = QId#qid.lcid, - LC1 = embed_vars(intro_set_line({QId,f1}, Vs), Id), - LC2 = embed_vars(intro_set_line({QId,f2}, Vs), Id), - AnyLine = -1, + AnyLine = anno0(), + Vars = [{var,AnyLine,V} || V <- Vs], + LC = embed_vars(Vars, AnyLine), + LC1 = intro_anno(LC, before, QId, NodeInfo), + LC2 = intro_anno(LC, 'after', QId, NodeInfo), Filter = {block,AnyLine,[LC1,Filter0,LC2]}, {Filter,{GVs,[{QId,[]} | QIds]},Foo} end, @@ -317,9 +391,15 @@ intro_variables(FormsNoShadows, State) -> Es0 = compile_errors(FForms), %% A variable is bound inside the filter if it is not bound before %% the filter, but it is bound after the filter (obviously). - Before = [{QId,V} || {{QId,f1},erl_lint,{unbound_var,V}} <- Es0], - After = [{QId,V} || {{QId,f2},erl_lint,{unbound_var,V}} <- Es0], - Unsafe = [{QId,V} || {{QId,f2},erl_lint,{unsafe_var,V,_Where}} <- Es0], + Before = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,before}} <- ets:lookup(NodeInfo, L)], + After = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], + Unsafe = [{QId,V} || + {L,erl_lint,{unsafe_var,V,_Where}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], ?DEBUG("Before = ~p~n", [Before]), ?DEBUG("After = ~p~n", [After]), ?DEBUG("Unsafe = ~p~n", [Unsafe]), @@ -328,9 +408,14 @@ intro_variables(FormsNoShadows, State) -> I1 = family(IV ++ GenVars), sofs:to_external(sofs:family_union(sofs:family(QIds), I1)). -intro_set_line(Tag, Vars) -> - L = erl_parse:set_line(1, fun(_) -> Tag end), - [{var,L,V} || V <- Vars]. +intro_anno(LC, Where, QId, NodeInfo) -> + Data = {QId,Where}, + Fun = fun(Anno) -> + Location = erl_anno:location(Anno), + true = ets:insert(NodeInfo, {Location,Data}), + Anno + end, + erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)). compile_errors(FormsNoShadows) -> case compile_forms(FormsNoShadows, []) of @@ -341,11 +426,8 @@ compile_errors(FormsNoShadows) -> lists:flatmap(fun({_File,Es}) -> Es end, Errors) end. --define(MAX_NUM_OF_LINES, 23). % assume max 1^23 lines (> 8 millions) - compile_forms(Forms0, Options) -> - Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ - [{eof,1 bsl ?MAX_NUM_OF_LINES}], + Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ [{eof,anno0()}], try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> @@ -384,20 +466,23 @@ bitstr_options() -> %% for each ListExpr. The expression mentions all introduced variables %% occurring in ListExpr. Running the function through the compiler %% yields error messages for erroneous use of introduced variables. -%% The messages have the form -%% {{extra,LineNo,File,Var},Module,{unbound_var,V}}, where Var is the -%% original variable name and V is the name invented by no_shadows/2. %% used_genvar_check(FormsNoShadows, State) -> - F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) + NodeInfo = State#state.node_info, + F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) when T =:= b_generate; T =:= generate -> - F = fun({var, _, V}=Var) -> - {var, L, OrigVar} = undo_no_shadows(Var), - AF = fun(Line) -> - {extra, Line, get(?QLC_FILE), OrigVar} - end, - L2 = erl_parse:set_line(L, AF), - {var, L2, V} + F = fun(Var) -> + {var, Anno0, OrigVar} = + undo_no_shadows(Var, State), + {var, Anno, _} = NewVar = save_anno(Var, NodeInfo), + Location0 = erl_anno:location(Anno0), + Location = erl_anno:location(Anno), + [{Location, Data}] = + ets:lookup(NodeInfo, Location), + Pos = {Location0,get(?QLC_FILE),OrigVar}, + NData = Data#{genvar_pos => Pos}, + true = ets:insert(NodeInfo, {Location, NData}), + NewVar end, Vs = [Var || {var, _, V}=Var <- qlc:var_fold(F, [], LE), lists:member(V, IVsSoFar0)], @@ -411,12 +496,12 @@ used_genvar_check(FormsNoShadows, State) -> {QsIVs, IVsSoFar} = q_intro_vars(QId, QsIVs0, IVsSoFar0), {Filter, {QsIVs, Exprs}, IVsSoFar} end, - IntroVars = intro_variables(FormsNoShadows, State), - Acc0 = {IntroVars, [{atom, 0, true}]}, + Acc0 = {State#state.intro_vars, [{atom, anno0(), true}]}, {_, {[], Exprs}} = qual_fold(F, Acc0, [], FormsNoShadows, State), FunctionNames = [Name || {function, _, Name, _, _} <- FormsNoShadows], UniqueFName = qlc:aux_name(used_genvar, 1, sets:from_list(FunctionNames)), - {function,0,UniqueFName,0,[{clause,0,[],[],lists:reverse(Exprs)}]}. + A = anno0(), + {function,A,UniqueFName,0,[{clause,A,[],[],lists:reverse(Exprs)}]}. q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. @@ -514,7 +599,8 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% (calling LEf returns the objects generated by LE). transform(FormsNoShadows, State) -> - IntroVars = intro_variables(FormsNoShadows, State), + _ = erlang:system_flag(backtrace_depth, 500), + IntroVars = State#state.intro_vars, AllVars = sets:from_list(ordsets:to_list(qlc:vars(FormsNoShadows))), ?DEBUG("AllVars = ~p~n", [sets:to_list(AllVars)]), F1 = fun(QId, {generate,_,P,LE}, Foo, {GoI,SI}) -> @@ -588,8 +674,8 @@ transform(FormsNoShadows, State) -> [{match,L,{var,L,Fun},FunC}, {call,L,{var,L,Fun},As0}]}]}}, {ok, OrigE0} = dict:find(Id, Source), - OrigE = undo_no_shadows(OrigE0), - QCode = qcode(OrigE, XQCs, Source, L), + OrigE = undo_no_shadows(OrigE0, State), + QCode = qcode(OrigE, XQCs, Source, L, State), Qdata = qdata(XQCs, L), TemplateInfo = template_columns(Qs, E, AllIVs, Dependencies, State), @@ -598,7 +684,7 @@ transform(FormsNoShadows, State) -> Opt = opt_info(TemplateInfo, SizeInfo, JoinInfo, MSQs, L, EqColumnConstants, EqualColumnConstants), LCTuple = - case qlc_kind(OrigE, Qs) of + case qlc_kind(OrigE, Qs, State) of qlc -> {tuple,L,[?A(qlc_v1),FunW,QCode,Qdata,Opt]}; {simple, PL, LE, V} -> @@ -612,7 +698,7 @@ transform(FormsNoShadows, State) -> end, {NForms,{[],XW}} = qlc_mapfold(F2, {IntroVars,[]}, ModifiedForms1, State), display_forms(NForms), - {restore_line_numbers(NForms), State#state{xwarnings = XW}}. + {NForms, State#state{xwarnings = XW}}. join_kind(Qs, LcL, AllIVs, Dependencies, State) -> {EqualCols2, EqualColsN} = equal_columns(Qs, AllIVs, Dependencies, State), @@ -623,20 +709,21 @@ join_kind(Qs, LcL, AllIVs, Dependencies, State) -> if EqualColsN =/= []; MatchColsN =/= [] -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_complex_join}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_complex_join}]}]}; EqualCols2 =:= [], MatchCols2 =:= [] -> {[], []}; length(Tables) > 2 -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_many_joins}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_many_joins}]}]}; EqualCols2 =:= MatchCols2 -> {EqualCols2, []}; true -> {{EqualCols2, MatchCols2}, []} end. -qlc_kind(OrigE, Qs) -> - {OrigFilterData, OrigGeneratorData} = qual_data(undo_no_shadows(Qs)), +qlc_kind(OrigE, Qs, State) -> + {OrigFilterData, OrigGeneratorData} = + qual_data(undo_no_shadows(Qs, State)), OrigAllFilters = filters_as_one(OrigFilterData), {_FilterData, GeneratorData} = qual_data(Qs), case {OrigE, OrigAllFilters, OrigGeneratorData} of @@ -663,12 +750,12 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> lists:foldl(fun({_QId,{fil,_Filter}}, {[]=Frames,Warnings}) -> {Frames,Warnings}; ({_QId,{fil,Filter}}, {Frames,Warnings}) -> - case filter(set_line(Filter, 0), Frames, BindFun, + case filter(reset_anno(Filter), Frames, BindFun, State, Imported) of [] -> {[], [{get(?QLC_FILE), - [{abs_loc(element(2, Filter)),?APIMOD, + [{loc(element(2, Filter)),?APIMOD, nomatch_filter}]} | Warnings]}; Frames1 -> {Frames1,Warnings} @@ -678,7 +765,7 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> {failed, _, _} -> {Frames, [{get(?QLC_FILE), - [{abs_loc(element(2, Pattern)),?APIMOD, + [{loc(element(2, Pattern)),?APIMOD, nomatch_pattern}]} | Warnings]}; _ -> {Frames,Warnings} @@ -751,8 +838,8 @@ opt_constants(L, ColumnConstants) -> || IdNo <- Ns] ++ [{clause,L,[?V('_')],[],[?A(no_column_fun)]}]. -abstr(Term, Line) -> - erl_parse:abstract(Term, Line). +abstr(Term, Anno) -> + erl_parse:abstract(Term, loc(Anno)). %% Extra generators are introduced for join. join_quals(JoinInfo, QCs, L, LcNo, ExtraConstants, AllVars) -> @@ -837,9 +924,10 @@ join_handle(AP, L, [F, H, O, C], Constants) -> {{var, _, _}, []} -> {'fun',L,{clauses,[{clause,L,[H],[],[H]}]}}; _ -> + A = anno0(), G0 = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},O]}, - list2op([{op,0,Op,Con,Call} || {Con,Op} <- Cs], 'or') + Call = {call,A,{atom,A,element},[{integer,A,Col},O]}, + list2op([{op,A,Op,Con,Call} || {Con,Op} <- Cs], 'or') end || {Col,Cs} <- Constants], G = if G0 =:= [] -> G0; true -> [G0] end, CC1 = {clause,L,[AP],G,[{cons,L,O,closure({call,L,F,[F,C]},L)}]}, @@ -876,14 +964,15 @@ join_handle_constants(QId, ExtraConstants) -> %% order the traverse fun would return them. column_fun(Columns, QualifierNumber, LcL) -> + A = anno0(), ColCls0 = [begin true = Vs0 =/= [], % at least one value to look up Vs1 = list2cons(Vs0), - Fils1 = {tuple,0,[{atom,0,FTag}, + Fils1 = {tuple,A,[{atom,A,FTag}, lists:foldr - (fun(F, A) -> {cons,0,{integer,0,F},A} - end, {nil,0}, Fils)]}, + (fun(F, Ac) -> {cons,A,{integer,A,F},Ac} + end, {nil,A}, Fils)]}, Tag = case ordsets:to_list(qlc:vars(Vs1)) of Imp when length(Imp) > 0, % imported vars length(Vs0) > 1 -> @@ -891,13 +980,13 @@ column_fun(Columns, QualifierNumber, LcL) -> _ -> values end, - Vs = {tuple,0,[{atom,0,Tag},Vs1,Fils1]}, - {clause,0,[erl_parse:abstract(Col)],[],[Vs]} + Vs = {tuple,A,[{atom,A,Tag},Vs1,Fils1]}, + {clause,A,[erl_parse:abstract(Col)],[],[Vs]} end || {{CIdNo,Col}, Vs0, {FTag,Fils}} <- Columns, CIdNo =:= QualifierNumber] - ++ [{clause,0,[{var,0,'_'}],[],[{atom,0,false}]}], - ColCls = set_line(ColCls0, LcL), + ++ [{clause,A,[{var,A,'_'}],[],[{atom,A,false}]}], + ColCls = set_anno(ColCls0, LcL), {'fun', LcL, {clauses, ColCls}}. %% Tries to find columns of the template that (1) are equal to (or @@ -920,7 +1009,7 @@ template_columns(Qs0, E0, AllIVs, Dependencies, State) -> MatchColumns = eq_columns2(Qs, AllIVs, Dependencies, State), Equal = template_cols(EqualColumns), Match = template_cols(MatchColumns), - L = 0, + L = anno0(), if Match =:= Equal -> [{?V('_'), Match}]; @@ -947,7 +1036,7 @@ template_cols(ColumnClasses) -> template_as_pattern(E) -> P = simple_template(E), - {?TID,foo,foo,{gen,P,{nil,0}}}. + {?TID,foo,foo,{gen,P,{nil,anno0()}}}. simple_template({call,L,{remote,_,{atom,_,erlang},{atom,_,element}}=Call, [{integer,_,I}=A1,A2]}) when I > 0 -> @@ -1004,10 +1093,10 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> GQId =:= QId2, {FQId,{fil,F}}=Filter <- Filters, % guard filters only FQId =:= QId] - ++ [{GId#qid.no,Pattern,[],{atom,0,true}} || + ++ [{GId#qid.no,Pattern,[],{atom,anno0(),true}} || {GId,{gen,Pattern,_}} <- GeneratorData, lists:member(GId, NoFilterGIds)], - E = {nil, 0}, + E = {nil, anno0()}, GF = [{{GNum,Pattern},Filter} || {GNum,Pattern,Filter,F} <- Candidates, no =/= try_ms(E, Pattern, F, State)], @@ -1024,7 +1113,7 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> %% expressione can be replaced by a match specification. [{GNum, AbstrMS, all}] catch _:_ -> - {TemplVar, _} = anon_var({var,0,'_'}, 0), + {TemplVar, _} = anon_var({var,anno0(),'_'}, 0), [one_gen_match_spec(GNum, Pattern, GFilterData, State, TemplVar) || {{GNum,Pattern},GFilterData} <- GFFL] end. @@ -1038,7 +1127,7 @@ gen_ms(E, Pattern, GFilterData, State) -> {ok, MS, AMS} = try_ms(E, Pattern, filters_as_one(GFilterData), State), case MS of [{'$1',[true],['$1']}] -> - {atom, 0, no_match_spec}; + {atom, anno0(), no_match_spec}; _ -> AMS end. @@ -1060,7 +1149,7 @@ pattern_as_template({match,_,_E,{var,_,_}=V}=P, _TemplVar) -> pattern_as_template({match,_,{var,_,_}=V,_E}=P, _TemplVar) -> {V, P}; pattern_as_template(E, TemplVar) -> - L = 0, + L = anno0(), {TemplVar, {match, L, E, TemplVar}}. %% Tries to find columns which are compared or matched against @@ -1203,7 +1292,7 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, ColFil = [{Column, FId#qid.no} || {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), - [] =/= (SFs = safe_filter(set_line(Fil, 0), PatternFrames, + [] =/= (SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported)), {GId,PV} <- PatternVars, [] =/= @@ -1392,7 +1481,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, JF = unify(JoinOp, V1, V2, JF2, BindFun, Imported), %% "Run" the filter: - SFs = safe_filter(set_line(Fil, 0), PatternFrames, + SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported), JImp = qlc:vars([SFs, JF]), % kludge lists:all(fun(Frame) -> @@ -1403,7 +1492,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, filter_info(FilterData, AllIVs, Dependencies, State) -> FilterList = filter_list(FilterData, Dependencies, State), - Filter0 = set_line(filters_as_one(FilterList), 0), + Filter0 = reset_anno(filters_as_one(FilterList)), Anon0 = 0, {Filter, Anon1} = anon_var(Filter0, Anon0), Imported = ordsets:subtract(qlc:vars(Filter), % anonymous too @@ -1510,7 +1599,7 @@ pattern(P0, AnonI, Frame0, BindFun, State) -> catch _:_ -> P0 % template, records already expanded end, %% Makes test for equality simple: - P2 = set_line(P1, 0), + P2 = reset_anno(P1), {P3, AnonN} = anon_var(P2, AnonI), {P4, F1} = match_in_pattern(tuple2cons(P3), Frame0, BindFun), {P, F2} = element_calls(P4, F1, BindFun, _Imp=[]), % kludge for templates @@ -1550,8 +1639,11 @@ anon_var(E, AnonI) -> (Var, N) -> {Var, N} end, AnonI, E). -set_line(T, L) -> - map_lines(fun(_L) -> L end, T). +reset_anno(T) -> + set_anno(T, anno0()). + +set_anno(T, A) -> + erl_parse:map_anno(fun(_L) -> A end, T). -record(fstate, {state, bind_fun, imported}). @@ -1673,7 +1765,7 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> %% same variables have to be the representatives in every frame.) SizesVarsL = [begin - PatVar = {var,0,PV}, + PatVar = {var,anno0(),PV}, PatternSizes = [pattern_size([F], PatVar, false) || F <- Fs], MaxPZ = lists:max([0 | PatternSizes -- [undefined]]), @@ -1692,8 +1784,8 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> Rs = [ begin RL = [{{PatN,Col},cons2tuple(element(2, Const))} || - {V, Col} <- lists:zip(sublist(Vars, PatSz), - seq(1, PatSz)), + {V, Col} <- lists:zip(lists:sublist(Vars, PatSz), + lists:seq(1, PatSz)), %% Do not handle the case where several %% values compare equal, e.g. "X =:= 1 %% andalso X == 1.0". Looking up both @@ -1722,11 +1814,11 @@ frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> [C || {_,Vs}=C <- sofs:to_external(Cs), not col_ignore(Vs, CompOp)]. pat_vars(N) -> - [unique_var() || _ <- seq(1, N)]. + [unique_var() || _ <- lists:seq(1, N)]. pat_tuple(Sz, Vars) when is_integer(Sz), Sz > 0 -> TupleTail = unique_var(), - {cons_tuple, list2cons(sublist(Vars, Sz) ++ TupleTail)}; + {cons_tuple, list2cons(lists:sublist(Vars, Sz) ++ TupleTail)}; pat_tuple(_, _Vars) -> unique_var(). @@ -1740,7 +1832,7 @@ col_ignore(Vs, '==') -> pattern_sizes(PatternVars, Fs) -> [{QId#qid.no, Size} || {QId,PV} <- PatternVars, - undefined =/= (Size = pattern_size(Fs, {var,0,PV}, true))]. + undefined =/= (Size = pattern_size(Fs, {var,anno0(),PV}, true))]. pattern_size(Fs, PatternVar, Exact) -> Fun = fun(F) -> (deref_pattern(_Imported = []))(PatternVar, F) end, @@ -1768,7 +1860,8 @@ prep_expr(E, F, S, BF, Imported) -> element_calls(tuple2cons(expand_expr_records(E, S)), F, BF, Imported). unify_column(Frame, Var, Col, BindFun, Imported) -> - Call = {call,0,{atom,0,element},[{integer,0,Col}, {var,0,Var}]}, + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col}, {var,A,Var}]}, element_calls(Call, Frame, BindFun, Imported). %% cons_tuple is used for representing {V1, ..., Vi | TupleTail}. @@ -1800,19 +1893,21 @@ element_calls(E, F, _BF, _Imported) -> {E, F}. unique_var() -> - {var, 0, make_ref()}. + {var, anno0(), make_ref()}. is_unique_var({var, _L, V}) -> is_reference(V). expand_pattern_records(P, State) -> - E = {'case',0,{atom,0,true},[{clause,0,[P],[],[{atom,0,true}]}]}, - {'case',_,_,[{clause,0,[NP],_,_}]} = expand_expr_records(E, State), + A = anno0(), + E = {'case',A,{atom,A,true},[{clause,A,[P],[],[{atom,A,true}]}]}, + {'case',_,_,[{clause,A,[NP],_,_}]} = expand_expr_records(E, State), NP. expand_expr_records(E, State) -> RecordDefs = State#state.records, - Forms = RecordDefs ++ [{function,1,foo,0,[{clause,1,[],[],[pe(E)]}]}], + A = anno1(), + Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = erl_expand_records:module(Forms, [no_strict_record_tests]), NE. @@ -2126,15 +2221,15 @@ tuple2cons(E) -> E. list2cons([E | Es]) -> - {cons, 0, E, list2cons(Es)}; + {cons, anno0(), E, list2cons(Es)}; list2cons([]) -> - {nil, 0}; + {nil, anno0()}; list2cons(E) -> E. %% Returns {..., Variable} if Variable is a tuple tail. cons2tuple({cons_tuple, Es}) -> - {tuple, 0, cons2list(Es)}; + {tuple, anno0(), cons2list(Es)}; cons2tuple(T) when is_tuple(T) -> list_to_tuple(cons2tuple(tuple_to_list(T))); cons2tuple([E | Es]) -> @@ -2173,11 +2268,10 @@ bindings_subset(F1, F2, Imp) -> %% not to have guard semantics, affected filters will have to be %% recognized and excluded here as well. try_ms(E, P, Fltr, State) -> - L = 1, + L = anno1(), Fun = {'fun',L,{clauses,[{clause,L,[P],[[Fltr]],[E]}]}}, Expr = {call,L,{remote,L,{atom,L,ets},{atom,L,fun2ms}},[Fun]}, - Form0 = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, - Form = restore_line_numbers(Form0), + Form = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, X = ms_transform:parse_transform(State#state.records ++ [Form], []), case catch begin @@ -2194,11 +2288,11 @@ try_ms(E, P, Fltr, State) -> end. filters_as_one([]) -> - {atom, 0, true}; + {atom, anno0(), true}; filters_as_one(FilterData) -> [{_,{fil,Filter1}} | Filters] = lists:reverse(FilterData), lists:foldr(fun({_QId,{fil,Filter}}, AbstF) -> - {op,0,'andalso',Filter,AbstF} + {op,anno0(),'andalso',Filter,AbstF} end, Filter1, Filters). qual_data(Qualifiers) -> @@ -2233,38 +2327,40 @@ qdata([], L) -> {nil,L}. qcon(Cs) -> - list2cons([{tuple,0,[{integer,0,Col},list2cons(qcon1(ConstOps))]} || + A = anno0(), + list2cons([{tuple,A,[{integer,A,Col},list2cons(qcon1(ConstOps))]} || {Col,ConstOps} <- Cs]). qcon1(ConstOps) -> - [{tuple,0,[Const,abstr(Op, 0)]} || {Const,Op} <- ConstOps]. + A = anno0(), + [{tuple,A,[Const,abstr(Op, A)]} || {Const,Op} <- ConstOps]. %% The original code (in Source) is used for filters and the template %% since the translated code can have QLCs and we don't want them to %% be visible. -qcode(E, QCs, Source, L) -> +qcode(E, QCs, Source, L, State) -> CL = [begin Bin = term_to_binary(C, [compressed]), {bin, L, [{bin_element, L, {string, L, binary_to_list(Bin)}, default, default}]} end || {_,C} <- lists:keysort(1, [{qlc:template_state(),E} | - qcode(QCs, Source)])], + qcode(QCs, Source, State)])], {'fun', L, {clauses, [{clause, L, [], [], [{tuple, L, CL}]}]}}. -qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source) -> - [{GoI,undo_no_shadows(P)} | qcode(QCs, Source)]; -qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source) -> +qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source, State) -> + [{GoI,undo_no_shadows(P, State)} | qcode(QCs, Source, State)]; +qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source, State) -> {ok,OrigF} = dict:find(QId, Source), - [{GoI,undo_no_shadows(OrigF)} | qcode(QCs, Source)]; -qcode([], _Source) -> + [{GoI,undo_no_shadows(OrigF, State)} | qcode(QCs, Source, State)]; +qcode([], _Source, _State) -> []. closure(Code, L) -> {'fun',L,{clauses,[{clause,L,[],[],[Code]}]}}. -simple(L, Var, Init, Line) -> - {tuple,L,[?A(simple_v1),?A(Var),Init,?I(Line)]}. +simple(L, Var, Init, Anno) -> + {tuple,L,[?A(simple_v1),?A(Var),Init,abstr(loc(Anno), Anno)]}. clauses([{QId,{QIVs,{QualData,GoI,S}}} | QCs], RL, Fun, Go, NGV, E, IVs,St) -> ?DEBUG("QIVs = ~p~n", [QIVs]), @@ -2426,19 +2522,22 @@ aux_var(Name, LcN, QN, N, AllVars) -> qlc:aux_name(lists:concat([Name, LcN, '_', QN, '_']), N, AllVars). no_compiler_warning(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). + Anno = erl_anno:new(L), + erl_anno:set_generated(true, Anno). -abs_loc(L) -> - loc(erl_parse:set_line(L, fun(Line) -> abs(Line) end)). - -loc(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. +loc(A) -> + erl_anno:location(A). list2op([E], _Op) -> E; list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. + {op,anno0(),Op,E,list2op(Es, Op)}. + +anno0() -> + erl_anno:new(0). + +anno1() -> + erl_anno:new(1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2491,13 +2590,61 @@ qlcmf(T, _F, _Imp, A, No) -> occ_vars(E) -> qlc:var_fold(fun({var,_L,V}) -> V end, [], E). +%% Every Anno is replaced by a unique number. The number is used in a +%% table that holds data about the abstract node where Anno resides. +%% In particular, the original location is kept there, so that the +%% original abstract code can be re-created. +save_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + N = next_slot(NodeInfo), + Location = erl_anno:location(Anno), + Data = {N, #{location => Location}}, + true = ets:insert(NodeInfo, Data), + erl_anno:new(N) + end, + erl_parse:map_anno(F, Abstr). + +next_slot(T) -> + I = ets:update_counter(T, var_n, 1), + case ets:lookup(T, I) of + [] -> + I; + _ -> + next_slot(T) + end. + +restore_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, Data}] -> + OrigLocation = maps:get(location, Data), + erl_anno:set_location(OrigLocation, Anno); + [{Location}] -> % generated code + Anno; + [] -> + Anno + end + end, + erl_parse:map_anno(F, Abstr). + +restore_loc(Location, #state{node_info = NodeInfo}) -> + case ets:lookup(NodeInfo, Location) of + [{Location, #{location := OrigLocation}}] -> + OrigLocation; + [{Location}] -> + Location; + [] -> + Location + end. + no_shadows(Forms0, State) -> %% Variables that may shadow other variables are introduced in %% LCs and Funs. Such variables (call them SV, Shadowing %% Variables) are now renamed. Each (new) occurrence in a pattern %% is assigned an index (integer), unique in the file. %% - %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons} + %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons,State} %% holds the last index used for each SV (LastIndex), the SVs in %% the current scope (ActiveVars), used SVs (UsedVars, the indexed %% name is the key), all variables occurring in the file @@ -2507,16 +2654,15 @@ no_shadows(Forms0, State) -> %% the indexed name of an SV occurs in the file, next index is %% tried (to avoid mixing up introduced names with existing ones). %% - %% The original names of variables are kept in the line number - %% position of the abstract code: {var, {nos, OriginalName, L}, - %% NewName}. undo_no_shadows/1 re-creates the original code. + %% The original names of variables are kept in a table in State. + %% undo_no_shadows/2 re-creates the original code. AllVars = sets:from_list(ordsets:to_list(qlc:vars(Forms0))), ?DEBUG("nos AllVars = ~p~n", [sets:to_list(AllVars)]), VFun = fun(_Id, LC, Vs) -> nos(LC, Vs) end, LI = ets:new(?APIMOD,[]), UV = ets:new(?APIMOD,[]), D0 = dict:new(), - S1 = {LI, D0, UV, AllVars, []}, + S1 = {LI, D0, UV, AllVars, [], State}, _ = qlc_mapfold(VFun, S1, Forms0, State), ?DEBUG("UsedIntroVars = ~p~n", [ets:match_object(UV, '_')]), Singletons = ets:select(UV, ets:fun2ms(fun({K,0}) -> K end)), @@ -2524,7 +2670,7 @@ no_shadows(Forms0, State) -> true = ets:delete_all_objects(LI), true = ets:delete_all_objects(UV), %% Do it again, this time we know which variables are singletons. - S2 = {LI, D0, UV, AllVars, Singletons}, + S2 = {LI, D0, UV, AllVars, Singletons, State}, {Forms,_} = qlc_mapfold(VFun, S2, Forms0, State), true = ets:delete(LI), true = ets:delete(UV), @@ -2568,11 +2714,11 @@ nos({lc,L,E0,Qs0}, S) -> {Qs, S1} = lists:mapfoldl(F, S, Qs0), {E, _} = nos(E0, S1), {{lc,L,E,Qs}, S}; -nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg}=S) when V =/= '_' -> +nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg,State}=S) when V =/= '_' -> case used_var(V, Vs, UV) of {true, VN} -> - NL = nos_var(L, V), - {{var,NL,VN}, S}; + nos_var(L, V, State), + {{var,L,VN}, S}; false -> {Var, S} end; @@ -2590,7 +2736,7 @@ nos_pattern([P0 | Ps0], S0, PVs0) -> {P, S1, PVs1} = nos_pattern(P0, S0, PVs0), {Ps, S, PVs} = nos_pattern(Ps0, S1, PVs1), {[P | Ps], S, PVs}; -nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> +nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg,State}, PVs0) when V =/= '_' -> {Name, Vs, PVs} = case lists:keyfind(V, 1, PVs0) of {V, VN} -> @@ -2604,16 +2750,25 @@ nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> end, {N, Vs1, [{V,VN} | PVs0]} end, - NL = nos_var(L, V), - {{var,NL,Name}, {LI,Vs,UV,A,Sg}, PVs}; + nos_var(L, V, State), + {{var,L,Name}, {LI,Vs,UV,A,Sg,State}, PVs}; nos_pattern(T, S0, PVs0) when is_tuple(T) -> {TL, S, PVs} = nos_pattern(tuple_to_list(T), S0, PVs0), {list_to_tuple(TL), S, PVs}; nos_pattern(T, S, PVs) -> {T, S, PVs}. -nos_var(L, Name) -> - erl_parse:set_line(L, fun(Line) -> {nos,Name,Line} end). +nos_var(Anno, Name, State) -> + NodeInfo = State#state.node_info, + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := _}}] -> + true; + [{Location, Data}] -> + true = ets:insert(NodeInfo, {Location, Data#{name => Name}}); + [] -> % cannot happen + true + end. used_var(V, Vs, UV) -> case dict:find(V, Vs) of @@ -2638,69 +2793,30 @@ next_var(V, Vs, AllVars, LI, UV) -> {VN, NVs} end. -undo_no_shadows(E) -> - var_map(fun undo_no_shadows1/1, E). - -undo_no_shadows1({var, L, _}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,V,_VL}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - undo_no_shadows1({var, NL, V}); - _Else -> - Var - end. - -restore_line_numbers(E) -> - var_map(fun restore_line_numbers1/1, E). +undo_no_shadows(E, State) -> + var_map(fun(Anno) -> undo_no_shadows1(Anno, State) end, E). -restore_line_numbers1({var, L, V}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,_,_}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - restore_line_numbers1({var, NL, V}); - _Else -> +undo_no_shadows1({var, Anno, _}=Var, State) -> + Location = erl_anno:location(Anno), + NodeInfo = State#state.node_info, + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := Name}}] -> + {var, Anno, Name}; + _ -> Var end. %% QLC identifier. %% The first one encountered in the file has No=1. -make_lcid(Attrs, No) when is_integer(No), No > 0 -> - F = fun(Line) when is_integer(Line), Line < (1 bsl ?MAX_NUM_OF_LINES) -> - sgn(Line) * ((No bsl ?MAX_NUM_OF_LINES) + sgn(Line) * Line) - end, - erl_parse:set_line(Attrs, F). - -is_lcid(Attrs) -> - try - {line,Id} = erl_parse:get_attribute(Attrs, line), - is_integer(Id) andalso (abs(Id) > (1 bsl ?MAX_NUM_OF_LINES)) - catch _:_ -> - false - end. - -get_lcid_no(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - abs(Id) bsr ?MAX_NUM_OF_LINES. - -get_lcid_line(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - sgn(Id) * (abs(Id) band ((1 bsl ?MAX_NUM_OF_LINES) - 1)). +make_lcid(Anno, No) when is_integer(No), No > 0 -> + {No, erl_anno:line(Anno)}. -sgn(X) when X >= 0 -> - 1; -sgn(X) when X < 0 -> - -1. +get_lcid_no({No, _Line}) -> + No. -seq(S, E) when S - E =:= 1 -> - []; -seq(S, E) -> - lists:seq(S, E). - -sublist(_, 0) -> - []; -sublist(L, N) -> - lists:sublist(L, N). +get_lcid_line({_No, Line}) -> + Line. qid(LCId, No) -> #qid{no = No, lcid = LCId}. 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.erl b/lib/stdlib/src/shell.erl index 679c13f0cf..c6ba574ff4 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -314,7 +314,8 @@ prompt(N, Eval0, Bs0, RT, Ds0) -> case get_prompt_func() of {M,F} -> L = [{history,N}], - C = {call,1,{remote,1,{atom,1,M},{atom,1,F}},[{value,1,L}]}, + A = erl_anno:new(1), + C = {call,A,{remote,A,{atom,A,M},{atom,A,F}},[{value,A,L}]}, {V,Eval,Bs,Ds} = shell_cmd([C], Eval0, Bs0, RT, Ds0, pmt), {Eval,Bs,Ds,case V of {pmt,Val} -> @@ -416,7 +417,7 @@ expand_expr({call,_L,{atom,_,v},[N]}, C) -> {_,undefined,_} -> no_command(N); {Ces,V,CommandN} when is_list(Ces) -> - {value,CommandN,V} + {value,erl_anno:new(CommandN),V} end; expand_expr({call,L,F,Args}, C) -> {call,L,expand_expr(F, C),expand_exprs(Args, C)}; @@ -901,7 +902,7 @@ prep_check({call,Line,{atom,_,f},[{var,_,_Name}]}) -> {atom,Line,ok}; prep_check({value,_CommandN,_Val}) -> %% erl_lint cannot handle the history expansion {value,_,_}. - {atom,0,ok}; + {atom,a0(),ok}; prep_check(T) when is_tuple(T) -> list_to_tuple(prep_check(tuple_to_list(T))); prep_check([E | Es]) -> @@ -913,7 +914,7 @@ expand_records([], E0) -> E0; expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], - L = 1, + L = erl_anno:new(1), E = prep_rec(E0), Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = @@ -1320,13 +1321,15 @@ list_bindings([{Name,Val}|Bs], RT) -> case erl_eval:fun_data(Val) of {fun_data,_FBs,FCs0} -> FCs = expand_value(FCs0), % looks nicer - F = {'fun',0,{clauses,FCs}}, - M = {match,0,{var,0,Name},F}, + A = a0(), + F = {'fun',A,{clauses,FCs}}, + M = {match,A,{var,A,Name},F}, io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); {named_fun_data,_FBs,FName,FCs0} -> FCs = expand_value(FCs0), % looks nicer - F = {named_fun,0,FName,FCs}, - M = {match,0,{var,0,Name},F}, + A = a0(), + F = {named_fun,A,FName,FCs}, + M = {match,A,{var,A,Name},F}, io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); false -> Namel = io_lib:fwrite(<<"~s = ">>, [Name]), @@ -1356,13 +1359,18 @@ expand_value(E) -> %% There is no abstract representation of funs. try_abstract(V, CommandN) -> try erl_parse:abstract(V) - catch _:_ -> {call,0,{atom,0,v},[{integer,0,CommandN}]} + catch + _:_ -> + A = a0(), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end. %% Rather than listing possibly huge results the calls to v/1 are shown. prep_list_commands(E) -> - substitute_v1(fun({value,CommandN,_V}) -> - {call,0,{atom,0,v},[{integer,0,CommandN}]} + A = a0(), + substitute_v1(fun({value,Anno,_V}) -> + CommandN = erl_anno:line(Anno), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end, E). substitute_v1(F, {value,_,_}=Value) -> @@ -1374,6 +1382,9 @@ substitute_v1(F, [E | Es]) -> substitute_v1(_F, E) -> E. +a0() -> + erl_anno:new(0). + check_and_get_history_and_results() -> check_env(shell_history_length), check_env(shell_saved_results), diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index a435d683a5..a27a35dca2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 +39,7 @@ edlin_expand, epp, eval_bits, + erl_anno, erl_bits, erl_compile, erl_eval, @@ -83,6 +84,7 @@ qlc, qlc_pt, queue, + rand, random, re, sets, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index a271229c59..61eb34d565 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -23,6 +23,7 @@ MODULES= \ dummy_via \ edlin_expand_SUITE \ epp_SUITE \ + erl_anno_SUITE \ erl_eval_SUITE \ erl_expand_records_SUITE \ erl_internal_SUITE \ @@ -53,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/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index b17e8bd186..9ab170c826 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -211,7 +211,7 @@ predef_mac(Config) when is_list(Config) -> ?line File = filename:join(?config(data_dir, Config), "mac3.erl"), ?line {ok, List} = epp:parse_file(File, [], []), ?line [_, - {attribute, LineCol1, l, Line1}, + {attribute, Anno, l, Line1}, {attribute, _, f, File}, {attribute, _, machine1, _}, {attribute, _, module, mac3}, @@ -219,13 +219,9 @@ predef_mac(Config) when is_list(Config) -> {attribute, _, ms, "mac3"}, {attribute, _, machine2, _} | _] = List, - ?line case LineCol1 of - Line1 -> ok; - {Line1,_} -> ok - end, + Line1 = erl_anno:line(Anno), ok. - variable_1(doc) -> []; variable_1(suite) -> @@ -553,11 +549,7 @@ otp_7702(Config) when is_list(Config) -> {ok, AC} = beam_lib:chunks(BeamFile, [abstract_code]), {file_7702,[{abstract_code,{_,Forms}}]} = AC, - Fun = fun(Attrs) -> - {line, L} = erl_parse:get_attribute(Attrs, line), - L - end, - Forms2 = [erl_lint:modify_line(Form, Fun) || Form <- Forms], + Forms2 = unopaque_forms(Forms), ?line [{attribute,1,file,_}, _, @@ -1395,9 +1387,10 @@ otp_10820(Config) when is_list(Config) -> do_otp_10820(File, C, PC) -> {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), ok = rpc:call(Node, file, write_file, [File, C]), - {ok,[{attribute,1,file,{File,1}}, - {attribute,2,module,any}, - {eof,2}]} = rpc:call(Node, epp, parse_file, [File, [],[]]), + {ok, Forms} = rpc:call(Node, epp, parse_file, [File, [],[]]), + [{attribute,1,file,{File,1}}, + {attribute,2,module,any}, + {eof,2}] = unopaque_forms(Forms), true = test_server:stop_node(Node), ok. @@ -1440,15 +1433,15 @@ encoding(Config) when is_list(Config) -> {attribute,1,module,encoding}, {error,_}, {error,{2,epp,cannot_parse}}, - {eof,2}]} = epp:parse_file(ErlFile, []), + {eof,2}]} = epp_parse_file(ErlFile, []), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,3}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1}]), + epp_parse_file(ErlFile, [{default_encoding,latin1}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,3}],[{encoding,none}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + epp_parse_file(ErlFile, [{default_encoding,latin1},extra]), %% Try a latin-1 file with encoding given in a comment. C2 = <<"-module(encoding). @@ -1459,27 +1452,27 @@ encoding(Config) when is_list(Config) -> {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, []), + epp_parse_file(ErlFile, []), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1}]), + epp_parse_file(ErlFile, [{default_encoding,latin1}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, [{default_encoding,utf8}]), + epp_parse_file(ErlFile, [{default_encoding,utf8}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [extra]), + epp_parse_file(ErlFile, [extra]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + epp_parse_file(ErlFile, [{default_encoding,latin1},extra]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [{default_encoding,utf8},extra]), + epp_parse_file(ErlFile, [{default_encoding,utf8},extra]), ok. @@ -1552,6 +1545,17 @@ errs([_|L], File) -> errs([], _File) -> []. +epp_parse_file(File, Opts) -> + case epp:parse_file(File, Opts) of + {ok, Forms} -> + {ok, unopaque_forms(Forms)}; + {ok, Forms, Other} -> + {ok, unopaque_forms(Forms), Other} + end. + +unopaque_forms(Forms) -> + [erl_parse:anno_to_term(Form) || Form <- Forms]. + run_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], Filename = "epp_test.erl", diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl new file mode 100644 index 0000000000..7632fbd324 --- /dev/null +++ b/lib/stdlib/test/erl_anno_SUITE.erl @@ -0,0 +1,569 @@ +%% +%% %CopyrightBegin% +%% +%% 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 +%% 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(erl_anno_SUITE). + +%-define(debug, true). + +-ifdef(debug). +-include_lib("test_server/include/test_server.hrl"). +-define(format(S, A), io:format(S, A)). +-else. +-include_lib("test_server/include/test_server.hrl"). +-define(format(S, A), ok). +-endif. + +-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([new/1, is_anno/1, generated/1, end_location/1, file/1, + line/1, location/1, record/1, text/1, bad/1, neg_line/1]). + +-export([parse_abstract/1, mapfold_anno/1]). + +all() -> + [{group, anno}, {group, parse}]. + +groups() -> + [{anno, [], [new, is_anno, generated, end_location, file, + line, location, record, text, bad, neg_line]}, + {parse, [], [parse_abstract, mapfold_anno]}]. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_Case, Config) -> + Dog=?t:timetrap(?t:minutes(1)), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case, _Config) -> + Dog=?config(watchdog, _Config), + test_server:timetrap_cancel(Dog), + ok. + +-define(INFO(T, V), {T, V}). + +-dialyzer({no_fail_call, new/1}). +new(doc) -> + ["Test erl_anno:new/1"]; +new(_Config) -> + {'EXIT', {badarg, _}} = + (catch erl_anno:new([{location,1},{text, "text"}])), % badarg + ok. + +is_anno(doc) -> + ["Test erl_anno:is_anno/1"]; +is_anno(_Config) -> + false = erl_anno:is_anno(a), + false = erl_anno:is_anno({a}), + false = erl_anno:is_anno([]), + false = erl_anno:is_anno([{location, 1}|{generated, true}]), + false = erl_anno:is_anno([{generated,false}]), + false = erl_anno:is_anno([{generated,true}]), + false = erl_anno:is_anno([{location,1},{file,nofile}]), + false = erl_anno:is_anno([{location,1},{text,notext}]), + false = erl_anno:is_anno([{location,1},{text,[a,b,c]}]), + + true = erl_anno:is_anno(erl_anno:new(1)), + A0 = erl_anno:new({1, 17}), + true = erl_anno:is_anno(A0), + A1 = erl_anno:set_generated(true, A0), + true = erl_anno:is_anno(A1), + A2 = erl_anno:set_file("", A1), + true = erl_anno:is_anno(A2), + A3 = erl_anno:set_record(true, A2), + true = erl_anno:is_anno(A3), + A4 = erl_anno:set_text("text", A3), + true = erl_anno:is_anno(A4), + A5 = erl_anno:set_file(<<"filename">>, A4), + true = erl_anno:is_anno(A5), + ok. + +generated(doc) -> + ["Test 'generated'"]; +generated(_Config) -> + test(1, [{generated, true}, {generated, false}]), + test(1, [{generated, false}, {generated, true}, {generated, false}]), + test({1, 17}, [{generated, false}, + {generated, true}, + {generated, false}]), + test({1, 17}, [{text, "text", [{end_location, {1, 21}}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + ok. + +end_location(doc) -> + ["Test 'end_location'"]; +end_location(_Config) -> + test({1, 17}, [{text, "TEXT", [{end_location, {1, 21}}, {length, 4}]}, + {text, "TEXT\n", [{end_location, {2, 1}}, {length, 5}]}, + {text, "TEXT\ntxt", [{end_location, {2, 4}}, {length, 8}]}]), + test(1, [{text, "TEXT", [{end_location, 1}, {length, 4}]}, + {text, "TEXT\n", [{end_location, 2}, {length, 5}]}, + {text, "TEXT\ntxt", [{end_location, 2}, {length, 8}]}]), + ok. + +file(doc) -> + ["Test 'file'"]; +file(_Config) -> + test(1, [{file, "name"}, {file, ""}]), + test({1, 17}, [{file, "name"}, {file, ""}]), + ok. + +line(doc) -> + ["Test 'line'"]; +line(_Config) -> + test(1, [{line, 17, [{location, 17}]}, + {location, {9, 8}, [{line, 9}, {column, 8}]}, + {line, 14, [{location, {14, 8}}]}]), + ok. + +location(doc) -> + ["Test 'location'"]; +location(_Config) -> + test(1, [{location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + test(1, [{generated, true}, + {location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + test(1, [{record, true}, + {location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + ok. + +record(doc) -> + ["Test 'record'"]; +record(_Config) -> + test({1, 17}, [{record, true}, {record, false}]), + test(1, [{record, true}, {record, false}]), + test({1, 17}, [{generated, false}, + {generated, true}, + {generated, false}]), + test({1, 17}, [{text, "text", [{end_location, {1, 21}}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + ok. + +text(doc) -> + ["Test 'text'"]; +text(_Config) -> + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {text, "", [{end_location, 1}, {length, 0}]}]), + test({1, 17}, [{text, "text", [{end_location, {1,21}}, {length, 4}]}, + {text, "", [{end_location, {1,17}}, {length, 0}]}]), + ok. + +-dialyzer({[no_opaque, no_fail_call], bad/1}). +bad(doc) -> + ["Test bad annotations"]; +bad(_Config) -> + Line = erl_anno:new(1), + LineColumn = erl_anno:new({1, 17}), + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(true, bad)), % 3rd arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(false, bad)), % 3rd arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(19, Line)), + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(19, LineColumn)), + + {'EXIT', {badarg, _}} = + (catch erl_anno:generated(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:end_location(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:file(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:text(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:record(bad)), % 1st arg not opaque + ok. + +neg_line(doc) -> + ["Test negative line numbers (OTP 18)"]; +neg_line(_Config) -> + neg_line1(false), + neg_line1(true), + ok. + +neg_line1(TextToo) -> + Minus8_0 = erl_anno:new(-8), + Plus8_0 = erl_anno:new(8), + Minus8C_0 = erl_anno:new({-8, 17}), + Plus8C_0 = erl_anno:new({8, 17}), + + [Minus8, Plus8, Minus8C, Plus8C] = + [case TextToo of + true -> + erl_anno:set_text("foo", A); + false -> + A + end || A <- [Minus8_0, Plus8_0, Minus8C_0, Plus8C_0]], + + tst(-3, erl_anno:set_location(3, Minus8)), + tst(-3, erl_anno:set_location(-3, Plus8)), + tst(-3, erl_anno:set_location(-3, Minus8)), + tst({-3,9}, erl_anno:set_location({3, 9}, Minus8)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8)), + tst(-3, erl_anno:set_location(3, Minus8C)), + tst(-3, erl_anno:set_location(-3, Plus8C)), + tst(-3, erl_anno:set_location(-3, Minus8C)), + tst({-3,9}, erl_anno:set_location({3, 9}, Minus8C)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8C)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8C)), + + tst(-8, erl_anno:set_generated(true, Plus8)), + tst(-8, erl_anno:set_generated(true, Minus8)), + tst({-8,17}, erl_anno:set_generated(true, Plus8C)), + tst({-8,17}, erl_anno:set_generated(true, Minus8C)), + tst(8, erl_anno:set_generated(false, Plus8)), + tst(8, erl_anno:set_generated(false, Minus8)), + tst({8,17}, erl_anno:set_generated(false, Plus8C)), + tst({8,17}, erl_anno:set_generated(false, Minus8C)), + + tst(-3, erl_anno:set_line(3, Minus8)), + tst(-3, erl_anno:set_line(-3, Plus8)), + tst(-3, erl_anno:set_line(-3, Minus8)), + tst({-3,17}, erl_anno:set_line(3, Minus8C)), + tst({-3,17}, erl_anno:set_line(-3, Plus8C)), + tst({-3,17}, erl_anno:set_line(-3, Minus8C)), + ok. + +tst(Term, Anno) -> + ?format("Term: ~p\n", [Term]), + ?format("Anno: ~p\n", [Anno]), + case anno_to_term(Anno) of + Term -> + ok; + Else -> + case lists:keyfind(location, 1, Else) of + {location, Term} -> + ok; + _Else2 -> + ?format("Else2 ~p\n", [_Else2]), + io:format("expected ~p\n got ~p\n", [Term, Else]), + exit({Term, Else}) + end + end. + +parse_abstract(doc) -> + ["Test erl_parse:new_anno/1, erl_parse:anno_to_term/1" + ", and erl_parse:anno_from_term/1"]; +parse_abstract(_Config) -> + T = sample_term(), + A = erl_parse:abstract(T, [{line,17}]), + T1 = erl_parse:anno_to_term(A), + Abstr = erl_parse:new_anno(T1), + T = erl_parse:normalise(Abstr), + Abstr2 = erl_parse:anno_from_term(T1), + T = erl_parse:normalise(Abstr2), + ok. + +mapfold_anno(doc) -> + ["Test erl_parse:{map_anno/2,fold_anno/3, and mapfold_anno/3}"]; +mapfold_anno(_Config) -> + T = sample_term(), + Abstr = erl_parse:abstract(T), + CF = fun(Anno, {L, D}) -> + {erl_anno:new(L), {L+1, dict:store(L, Anno, D)}} + end, + {U, {N, D}} = erl_parse:mapfold_anno(CF, {1, dict:new()}, Abstr), + SeqA = erl_parse:fold_anno(fun(Anno, Acc) -> [Anno|Acc] end, [], U), + Seq = [erl_anno:location(A) || A <- SeqA], + Seq = lists:seq(N-1, 1, -1), + NF = fun(Anno) -> + L = erl_anno:location(Anno), + dict:fetch(L, D) + end, + Abstr = erl_parse:map_anno(NF, U), + ok. + +sample_term() -> + %% This is just a sample. + {3,a,4.0,"foo",<<"bar">>,#{a => <<19:64/unsigned-little>>}, + [1000,2000]}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +test(StartLocation, Updates) -> + S0 = init(StartLocation), + A0 = erl_anno:new(StartLocation), + chk(S0, A0, []), + eval(Updates, S0, A0). + +eval([], _S0, _A0) -> + ok; +eval([{Item, Value}|Updates], S0, A0) -> + {S, A} = set(Item, Value, A0, S0, []), + eval(Updates, S, A); +eval([{Item, Value, Secondary}|Updates], S0, A0) -> + {S, A} = set(Item, Value, A0, S0, Secondary), + eval(Updates, S, A). + +init({Line, Column}) -> + lists:sort([{location, {Line, Column}} | default()]); +init(Line) when is_integer(Line) -> + lists:sort([{location, Line} | default()]). + +set(Item, Value, Anno0, State0, Secondary) -> + true = lists:member(Item, primary_items()), + ?format("Set '~w' to ~p\n", [Item, Value]), + State = set_value(Item, Value, State0), + Anno = anno_set(Item, Value, Anno0), + ?format("State0 ~p\n", [State0]), + ?format("State ~p\n", [State]), + ?format("Anno0 ~p\n", [anno_to_term(Anno0)]), + ?format("Anno ~p\n", [anno_to_term(Anno)]), + chk(State, Anno, Secondary), + ok = frame(Anno0, Anno, Secondary), + {State, Anno}. + +frame(OldAnno, NewAnno, Secondary) -> + SecItems = [I || {I, _} <- Secondary], + Frame = secondary_items() -- (SecItems ++ primary_items()), + ?format("Frame items ~p\n", [Frame]), + frame1(Frame, OldAnno, NewAnno). + +frame1([], _OldAnno, _NewAnno) -> + ok; +frame1([Item|Items], OldAnno, NewAnno) -> + V1 = anno_info(OldAnno, Item), + V2 = anno_info(NewAnno, Item), + ok = check_value(Item, V1, V2), + frame1(Items, OldAnno, NewAnno). + +chk(State, Anno, Secondary) -> + ok = check_simple(Anno), + ok = chk_primary(State, Anno), + ok = check_secondary(Secondary, State, Anno). + +chk_primary(State, Anno) -> + chk_primary(primary_items(), State, Anno). + +chk_primary([], _State, _Anno) -> + ok; +chk_primary([Item | Items], State, Anno) -> + V1 = primary_value(Item, State), + V2 = anno_info(Anno, Item), + ok = check_value(Item, V1, V2), + chk_primary(Items, State, Anno). + +check_secondary([], _State, _Anno) -> + ok; +check_secondary([{Item, _}=V1 | Secondary], State, Anno) -> + V2 = anno_info(Anno, Item), + case {V1, V2} of + {{Item, undefined}, undefined} -> + ok; + _ -> + ok = check_value(Item, V1, V2) + end, + check_secondary(Secondary, State, Anno). + +check_value(Item, V1, V2) -> + ?format("~w: V1 ~p\n", [Item, V1]), + ?format("~w: V2 ~p\n", [Item, V2]), + case V1 =:= V2 of + true -> + ok; + false -> + io:format("~w: expected ~p\n got ~p\n", [Item, V1, V2]), + exit({V1, V2}) + end. + +check_simple(Anno) -> + Term = anno_to_term(Anno), + case find_defaults(Term) of + [] -> + ok; + Ds -> + io:format("found default values ~w in ~p\n", [Ds, Anno]), + exit({defaults, Anno}) + end, + case check_simple1(Term) of + true -> + ok; + false -> + io:format("not simple ~p\n", [Anno]), + exit({not_simple, Anno}) + end. + +check_simple1(L) when is_integer(L) -> + true; +check_simple1({L, C}) when is_integer(L), is_integer(C) -> + true; +check_simple1(List) -> + case lists:sort(List) of + [{location, _}] -> + false; + _ -> + true + end. + +find_defaults(L) when is_list(L) -> + [I || + I <- default_items(), + {I1, Value} <- L, + I =:= I1, + Value =:= default_value(I)]; +find_defaults(_) -> + []. + +anno_to_term(Anno) -> + T = erl_anno:to_term(Anno), + maybe_sort(T). + +maybe_sort(L) when is_list(L) -> + lists:sort(L); +maybe_sort(T) -> + T. + +anno_set(file, Value, Anno) -> + erl_anno:set_file(Value, Anno); +anno_set(generated, Value, Anno) -> + erl_anno:set_generated(Value, Anno); +anno_set(line, Value, Anno) -> + erl_anno:set_line(Value, Anno); +anno_set(location, Value, Anno) -> + erl_anno:set_location(Value, Anno); +anno_set(record, Value, Anno) -> + erl_anno:set_record(Value, Anno); +anno_set(text, Value, Anno) -> + erl_anno:set_text(Value, Anno). + +anno_info(Anno, Item) -> + Value = + case Item of + column -> + erl_anno:column(Anno); + generated -> + erl_anno:generated(Anno); + end_location -> + erl_anno:end_location(Anno); + file -> + erl_anno:file(Anno); + length -> + case erl_anno:text(Anno) of + undefined -> + undefined; + Text -> + length(Text) + end; + line -> + erl_anno:line(Anno); + location -> + erl_anno:location(Anno); + record -> + erl_anno:record(Anno); + text -> + erl_anno:text(Anno); + _ -> + erlang:error(badarg, [Anno, Item]) + end, + if + Value =:= undefined -> + undefined; + true -> + {Item, Value} + end. + +%%% Originally 'location' was primary while 'line' and 'column' were +%%% secondary (their values are determined by 'location'). But since +%%% set_line() is used kind of frequently, 'line' is also primary, +%%% and 'location' secondary (depends on 'line'). 'line' need to be +%%% handled separately. + +set_value(line, Line, State) -> + {location, Location} = primary_value(location, State), + NewLocation = case Location of + {_, Column} -> + {Line, Column}; + _ -> + Line + end, + set_value(location, NewLocation, State); +set_value(Item, Value, State) -> + lists:ukeymerge(1, [{Item, Value}], State). + +primary_value(line, State) -> + {location, Location} = primary_value(location, State), + {line, case Location of + {Line, _} -> + Line; + Line -> + Line + end}; +primary_value(Item, State) -> + case lists:keyfind(Item, 1, State) of + false -> + undefined; + Tuple -> + Tuple + end. + +default() -> + [{Tag, default_value(Tag)} || Tag <- default_items()]. + +primary_items() -> + [file, generated, line, location, record, text]. + +secondary_items() -> + %% 'length' has not been implemented + [column, end_location, length, line, location]. + +default_items() -> + [generated, record]. + +default_value(generated) -> false; +default_value(record) -> false. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index a7c3fd3c2e..c0d9b7c466 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. 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 @@ -64,7 +64,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1 + maps/1,maps_type/1,otp_11851/1,otp_12195/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -93,7 +93,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851]. + maps, maps_type, otp_11851, otp_12195]. groups() -> [{unused_vars_warn, [], @@ -3834,6 +3834,40 @@ otp_11851(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +otp_12195(doc) -> + "OTP-12195: Check obsolete types (tailor made for OTP 18)."; +otp_12195(Config) when is_list(Config) -> + Ts = [{otp_12195_1, + <<"-export_type([r1/0]). + -type r1() :: erl_scan:line() + | erl_scan:column() + | erl_scan:location() + | erl_anno:line().">>, + [], + {warnings,[{2,erl_lint, + {deprecated_type,{erl_scan,line,0}, + "deprecated (will be removed in OTP 19); " + "use erl_anno:line() instead"}}, + {3,erl_lint, + {deprecated_type,{erl_scan,column,0}, + "deprecated (will be removed in OTP 19); use " + "erl_anno:column() instead"}}, + {4,erl_lint, + {deprecated_type,{erl_scan,location,0}, + "deprecated (will be removed in OTP 19); " + "use erl_anno:location() instead"}}]}}, + {otp_12195_2, + <<"-export_type([r1/0]). + -compile(nowarn_deprecated_type). + -type r1() :: erl_scan:line() + | erl_scan:column() + | erl_scan:location() + | erl_anno:line().">>, + [], + []}], + [] = run(Config, Ts), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index f71446dd64..1d63c8e17e 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,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 @@ -490,7 +490,7 @@ cond1(Config) when is_list(Config) -> [{cons,3,{atom,3,a},{cons,3,{atom,3,b},{nil,3}}}]}, {clause,4,[],[[{atom,4,true}]], [{tuple,5,[{atom,5,x},{atom,5,y}]}]}]}, - ?line CChars = lists:flatten(erl_pp:expr(C)), + CChars = flat_expr1(C), % ?line "cond {foo,bar} -> [a,b]; true -> {x,y} end" = CChars, ?line "cond\n" " {foo,bar} ->\n" @@ -557,7 +557,7 @@ messages(Config) when is_list(Config) -> lists:flatten(erl_pp:form({error,{some,"error"}})), ?line true = "{warning,{some,\"warning\"}}\n" =:= lists:flatten(erl_pp:form({warning,{some,"warning"}})), - ?line true = "\n" =:= lists:flatten(erl_pp:form({eof,0})), + "\n" = flat_form({eof,0}), ok. import_export(suite) -> @@ -616,27 +616,29 @@ hook(Config) when is_list(Config) -> do_hook(HookFun) -> Lc = parse_expr(binary_to_list(<<"[X || X <- [1,2,3]].">>)), H = HookFun(fun hook/4), - Expr = {call,0,{atom,0,fff},[{foo,Lc},{foo,Lc},{foo,Lc}]}, + A0 = erl_anno:new(0), + Expr = {call,A0,{atom,A0,fff},[{foo,Lc},{foo,Lc},{foo,Lc}]}, EChars = lists:flatten(erl_pp:expr(Expr, 0, H)), - Call = {call,0,{atom,0,foo},[Lc]}, - Expr2 = {call,0,{atom,0,fff},[Call,Call,Call]}, + Call = {call,A0,{atom,A0,foo},[Lc]}, + Expr2 = {call,A0,{atom,A0,fff},[Call,Call,Call]}, EChars2 = erl_pp:exprs([Expr2]), ?line true = EChars =:= lists:flatten(EChars2), EsChars = erl_pp:exprs([Expr], H), ?line true = EChars =:= lists:flatten(EsChars), - F = {function,1,ffff,0,[{clause,1,[],[],[Expr]}]}, + A1 = erl_anno:new(1), + F = {function,A1,ffff,0,[{clause,A1,[],[],[Expr]}]}, FuncChars = lists:flatten(erl_pp:function(F, H)), - F2 = {function,1,ffff,0,[{clause,1,[],[],[Expr2]}]}, + F2 = {function,A1,ffff,0,[{clause,A1,[],[],[Expr2]}]}, FuncChars2 = erl_pp:function(F2), ?line true = FuncChars =:= lists:flatten(FuncChars2), FFormChars = erl_pp:form(F, H), ?line true = FuncChars =:= lists:flatten(FFormChars), - A = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr}]}}, + A = {attribute,A1,record,{r,[{record_field,A1,{atom,A1,a},Expr}]}}, AChars = lists:flatten(erl_pp:attribute(A, H)), - A2 = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr2}]}}, + A2 = {attribute,A1,record,{r,[{record_field,A1,{atom,A1,a},Expr2}]}}, AChars2 = erl_pp:attribute(A2), ?line true = AChars =:= lists:flatten(AChars2), AFormChars = erl_pp:form(A, H), @@ -645,10 +647,10 @@ do_hook(HookFun) -> ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), %% A list (as before R6), not a list of lists. - G = [{op,1,'>',{atom,1,a},{foo,{atom,1,b}}}], % not a proper guard + G = [{op,A1,'>',{atom,A1,a},{foo,{atom,A1,b}}}], % not a proper guard GChars = lists:flatten(erl_pp:guard(G, H)), - G2 = [{op,1,'>',{atom,1,a}, - {call,0,{atom,0,foo},[{atom,1,b}]}}], % not a proper guard + G2 = [{op,A1,'>',{atom,A1,a}, + {call,A0,{atom,A0,foo},[{atom,A1,b}]}}], % not a proper guard GChars2 = erl_pp:guard(G2), ?line true = GChars =:= lists:flatten(GChars2), @@ -659,14 +661,14 @@ do_hook(HookFun) -> ?line true = EChars =:= lists:flatten(XEChars2), %% Note: no leading spaces before "begin". - Block = {block,0,[{match,0,{var,0,'A'},{integer,0,3}}, - {atom,0,true}]}, + Block = {block,A0,[{match,A0,{var,A0,'A'},{integer,A0,3}}, + {atom,A0,true}]}, ?line "begin\n A =" ++ _ = lists:flatten(erl_pp:expr(Block, 17, none)), %% Special... ?line true = - "{some,value}" =:= lists:flatten(erl_pp:expr({value,0,{some,value}})), + "{some,value}" =:= lists:flatten(erl_pp:expr({value,A0,{some,value}})), %% Silly... ?line true = @@ -674,8 +676,8 @@ do_hook(HookFun) -> flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), %% More compatibility: before R6 - OldIf = {'if',0,[{clause,0,[],[{atom,0,true}],[{atom,0,b}]}]}, - NewIf = {'if',0,[{clause,0,[],[[{atom,0,true}]],[{atom,0,b}]}]}, + OldIf = {'if',A0,[{clause,A0,[],[{atom,A0,true}],[{atom,A0,b}]}]}, + NewIf = {'if',A0,[{clause,A0,[],[[{atom,A0,true}]],[{atom,A0,b}]}]}, OldIfChars = lists:flatten(erl_pp:expr(OldIf)), NewIfChars = lists:flatten(erl_pp:expr(NewIf)), ?line true = OldIfChars =:= NewIfChars, @@ -691,7 +693,8 @@ ehook(HE, I, P, H, foo, bar) -> hook(HE, I, P, H). hook({foo,E}, I, P, H) -> - erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). + A = erl_anno:new(0), + erl_pp:expr({call,A,{atom,A,foo},[E]}, I, P, H). neg_indent(suite) -> []; @@ -774,7 +777,7 @@ otp_6911(Config) when is_list(Config) -> {var,6,'X'}, [{clause,7,[{atom,7,true}],[],[{integer,7,12}]}, {clause,8,[{atom,8,false}],[],[{integer,8,14}]}]}]}]}, - ?line Chars = lists:flatten(erl_pp:form(F)), + Chars = flat_form(F), ?line "thomas(X) ->\n" " case X of\n" " true ->\n" @@ -1084,10 +1087,11 @@ otp_10302(Config) when is_list(Config) -> Opts = [{hook, fun unicode_hook/4},{encoding,unicode}], Lc = parse_expr("[X || X <- [\"\x{400}\",\"\xFF\"]]."), - Expr = {call,0,{atom,0,fff},[{foo,{foo,Lc}},{foo,{foo,Lc}}]}, + A0 = erl_anno:new(0), + Expr = {call,A0,{atom,A0,fff},[{foo,{foo,Lc}},{foo,{foo,Lc}}]}, EChars = lists:flatten(erl_pp:expr(Expr, 0, Opts)), - Call = {call,0,{atom,0,foo},[{call,0,{atom,0,foo},[Lc]}]}, - Expr2 = {call,0,{atom,0,fff},[Call,Call]}, + Call = {call,A0,{atom,A0,foo},[{call,A0,{atom,A0,foo},[Lc]}]}, + Expr2 = {call,A0,{atom,A0,fff},[Call,Call]}, EChars2 = erl_pp:exprs([Expr2], U), EChars = lists:flatten(EChars2), [$\x{400},$\x{400}] = [C || C <- EChars, C > 255], @@ -1097,7 +1101,8 @@ otp_10302(Config) when is_list(Config) -> ok. unicode_hook({foo,E}, I, P, H) -> - erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). + A = erl_anno:new(0), + erl_pp:expr({call,A,{atom,A,foo},[E]}, I, P, H). otp_10820(doc) -> "OTP-10820. Unicode filenames."; @@ -1137,29 +1142,30 @@ otp_11100(Config) when is_list(Config) -> %% Cannot trigger the use of the hook function with export/import. "-export([{fy,a}/b]).\n" = pf({attribute,1,export,[{{fy,a},b}]}), + A1 = erl_anno:new(1), "-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" = - pf({attribute,1,type,{foo,{type,1,integer,[{foo,bar}]},[]}}), - pf({attribute,1,type, - {a,{type,1,range,[{integer,1,1},{foo,bar}]},[]}}), + pf({attribute,A1,type,{foo,{type,A1,integer,[{foo,bar}]},[]}}), + pf({attribute,A1,type, + {a,{type,A1,range,[{integer,A1,1},{foo,bar}]},[]}}), "-type foo(INVALID-FORM:{foo,bar}:) :: A.\n" = - pf({attribute,1,type,{foo,{var,1,'A'},[{foo,bar}]}}), + pf({attribute,A1,type,{foo,{var,A1,'A'},[{foo,bar}]}}), "-type foo() :: (INVALID-FORM:{foo,bar}: :: []).\n" = - pf({attribute,1,type, - {foo,{paren_type,1, - [{ann_type,1,[{foo,bar},{type,1,nil,[]}]}]}, + pf({attribute,A1,type, + {foo,{paren_type,A1, + [{ann_type,A1,[{foo,bar},{type,A1,nil,[]}]}]}, []}}), "-type foo() :: <<_:INVALID-FORM:{foo,bar}:>>.\n" = - pf({attribute,1,type, - {foo,{type,1,binary,[{foo,bar},{integer,1,0}]},[]}}), + pf({attribute,A1,type, + {foo,{type,A1,binary,[{foo,bar},{integer,A1,0}]},[]}}), "-type foo() :: <<_:10, _:_*INVALID-FORM:{foo,bar}:>>.\n" = - pf({attribute,1,type, - {foo,{type,1,binary,[{integer,1,10},{foo,bar}]},[]}}), + pf({attribute,A1,type, + {foo,{type,A1,binary,[{integer,A1,10},{foo,bar}]},[]}}), "-type foo() :: #r{INVALID-FORM:{foo,bar}: :: integer()}.\n" = - pf({attribute,1,type, - {foo,{type,1,record, - [{atom,1,r}, - {type,1,field_type, - [{foo,bar},{type,1,integer,[]}]}]}, + pf({attribute,A1,type, + {foo,{type,A1,record, + [{atom,A1,r}, + {type,A1,field_type, + [{foo,bar},{type,A1,integer,[]}]}]}, []}}), ok. @@ -1239,9 +1245,18 @@ strip_module_info(Bin) -> <<R:Start/binary,_/binary>> = Bin, R. -flat_expr(Expr) -> +flat_expr1(Expr0) -> + Expr = erl_parse:new_anno(Expr0), + lists:flatten(erl_pp:expr(Expr)). + +flat_expr(Expr0) -> + Expr = erl_parse:new_anno(Expr0), lists:flatten(erl_pp:expr(Expr, -1, none)). +flat_form(Form0) -> + Form = erl_parse:new_anno(Form0), + lists:flatten(erl_pp:form(Form)). + pp_forms(Bin) -> pp_forms(Bin, none). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 6ef947f0e3..fb85055b6c 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -138,7 +138,7 @@ iso88591(Config) when is_list(Config) -> A1s = [$h,$ä,$r], A2s = [$ö,$r,$e], %% Test parsing atom and variable characters. - {ok,Ts1,_} = erl_scan:string(V1s ++ " " ++ V2s ++ + {ok,Ts1,_} = erl_scan_string(V1s ++ " " ++ V2s ++ "\327" ++ A1s ++ " " ++ A2s), V1s = atom_to_list(element(3, nth(1, Ts1))), @@ -151,7 +151,7 @@ iso88591(Config) when is_list(Config) -> %% Test parsing and printing strings. S1 = V1s ++ "\327" ++ A1s ++ "\250" ++ A2s, S1s = "\"" ++ S1 ++ "\"", - {ok,Ts2,_} = erl_scan:string(S1s), + {ok,Ts2,_} = erl_scan_string(S1s), S1 = element(3, nth(1, Ts2)), S1s = flatten(print(element(3, nth(1, Ts2)))), ok %It all worked @@ -219,7 +219,7 @@ atoms() -> test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = - erl_scan:string("'$\\a'", {1,1}), + erl_scan_string("'$\\a'", {1,1}), ?line test("'$\\a'"), ok. @@ -268,24 +268,24 @@ punctuations() -> comments() -> ?line test("a %%\n b"), - ?line {ok,[],1} = erl_scan:string("%"), + {ok,[],1} = erl_scan_string("%"), ?line test("a %%\n b"), {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = - erl_scan:string("a %%\n b",{1,1}), + erl_scan_string("a %%\n b", {1,1}), {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = - erl_scan:string("a %%\n b",{1,1}, [return_comments]), + erl_scan_string("a %%\n b",{1,1}, [return_comments]), {ok,[{atom,{1,1},a}, {white_space,{1,2}," "}, {white_space,{1,5},"\n "}, {atom,{2,2},b}], {2,3}} = - erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), + erl_scan_string("a %%\n b",{1,1},[return_white_spaces]), {ok,[{atom,{1,1},a}, {white_space,{1,2}," "}, {comment,{1,3},"%%"}, {white_space,{1,5},"\n "}, {atom,{2,2},b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {2,3}} = erl_scan_string("a %%\n b",{1,1},[return]), ok. errors() -> @@ -337,11 +337,11 @@ base_integers() -> erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], - ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), + {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = - erl_scan:string("16#ef@", {1,1}, []), + erl_scan_string("16#ef@", {1,1}, []), {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = - erl_scan:string("16#eg@", {1,1}, []), + erl_scan_string("16#eg@", {1,1}, []), ok. @@ -382,8 +382,8 @@ dots() -> {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], [begin - R = erl_scan:string(S), - R2 = erl_scan:string(S, {1,1}, []) + R = erl_scan_string(S), + R2 = erl_scan_string(S, {1,1}, []) end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), @@ -417,7 +417,7 @@ dots() -> {white_space,{1,4},"\n"}, {dot,{2,1}}], {2,3}}, ""} = - erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options + erl_scan_tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, @@ -511,7 +511,7 @@ eof() -> %% An error before R13A. %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,abra}],1},eof} = - erl_scan:tokens(C2, eof, 1), + erl_scan_tokens(C2, eof, 1), %% With column. ?line {more, C3} = erl_scan:tokens([]," \n",{1,1}), @@ -520,7 +520,7 @@ eof() -> %% An error before R13A. %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = ?line {done,{ok,[{atom,_,abra}],{1,5}},eof} = - erl_scan:tokens(C4, eof, 1), + erl_scan_tokens(C4, eof, 1), %% Robert's scanner returns "" as LeftoverChars; %% the R12B scanner returns eof as LeftoverChars: (eof is correct) @@ -528,26 +528,26 @@ eof() -> %% An error before R13A. %% ?line {done,{error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,a}],1},eof} = - erl_scan:tokens(C5,eof,1), + erl_scan_tokens(C5,eof,1), %% With column. {more, C6} = erl_scan:tokens([], "a", {1,1}), %% An error before R13A. %% {done,{error,{1,erl_scan,scan},1},eof} = {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = - erl_scan:tokens(C6,eof,1), + erl_scan_tokens(C6,eof,1), %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), - ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), - ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), + {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), %% With column. {more, CCol} = erl_scan:tokens([], "a.", {1,1}), {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = - erl_scan:tokens(CCol,eof,1), + erl_scan_tokens(CCol,eof,1), {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = - erl_scan:string("foo.", {1,1}, []), + erl_scan_string("foo.", {1,1}, []), ok. @@ -628,23 +628,23 @@ crashes() -> options() -> %% line and column are not options, but tested here ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = - erl_scan:string("foo % bar", 1, return), + erl_scan_string("foo % bar", 1, return), ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = - erl_scan:string("foo % bar", 1, return_white_spaces), + erl_scan_string("foo % bar", 1, return_white_spaces), ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = - erl_scan:string("foo % bar", 1, return_comments), + erl_scan_string("foo % bar", 1, return_comments), ?line {ok,[{atom,17,foo}],17} = - erl_scan:string("foo % bar", 17), + erl_scan_string("foo % bar", 17), ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {a,1}, [])}), % type error ?line {ok,[{atom,_,foo}],{17,18}} = - erl_scan:string("foo % bar", {17,9}, []), + erl_scan_string("foo % bar", {17,9}, []), ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {1,0}, [])}), % type error ?line {ok,[{foo,1}],1} = - erl_scan:string("foo % bar",1, [{reserved_word_fun, + erl_scan_string("foo % bar",1, [{reserved_word_fun, fun(W) -> W =:= foo end}]), ?line {'EXIT',{badarg,_}} = (catch {foo, @@ -706,8 +706,9 @@ token_info() -> attributes_info() -> ?line {'EXIT',_} = (catch {foo,erl_scan:attributes_info(foo)}), % type error - ?line [{line,18}] = erl_scan:attributes_info(18), - ?line {location,19} = erl_scan:attributes_info(19, location), + [{line,18}] = erl_scan:attributes_info(erl_anno:new(18)), + {location,19} = + erl_scan:attributes_info(erl_anno:new(19), location), ?line {ok,[{atom,A0,foo}],_} = erl_scan:string("foo", 19, [text]), ?line {location,19} = erl_scan:attributes_info(A0, location), @@ -735,7 +736,9 @@ attributes_info() -> set_attribute() -> F = fun(Line) -> -Line end, - ?line -2 = erl_scan:set_attribute(line, 2, F), + Anno2 = erl_anno:new(2), + A0 = erl_scan:set_attribute(line, Anno2, F), + {line, -2} = erl_scan:attributes_info(A0, line), ?line {ok,[{atom,A1,foo}],_} = erl_scan:string("foo", {9,17}), ?line A2 = erl_scan:set_attribute(line, A1, F), ?line {line,-9} = erl_scan:attributes_info(A2, line), @@ -765,10 +768,15 @@ set_attribute() -> ?line {ok,[{atom,A6,foo}],_} = erl_scan:string("foo", 11, [text]), ?line A7 = erl_scan:set_attribute(line, A6, F2), - ?line {line,{17,11}} = erl_scan:attributes_info(A7, line), + %% Incompatible with pre 18: + %% {line,{17,11}} = erl_scan:attributes_info(A7, line), + {line,17} = erl_scan:attributes_info(A7, line), ?line {location,{17,11}} = % mixed up erl_scan:attributes_info(A7, location), - ?line [{line,{17,11}},{text,"foo"}] = + %% Incompatible with pre 18: + %% [{line,{17,11}},{text,"foo"}] = + %% erl_scan:attributes_info(A7, [line,column,text]), + [{line,17},{column,11},{text,"foo"}] = erl_scan:attributes_info(A7, [line,column,text]), ?line {'EXIT',_} = @@ -776,9 +784,13 @@ set_attribute() -> ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error + Attr10 = erl_anno:new(8), + Attr20 = erl_scan:set_attribute(line, Attr10, + fun(L) -> {nos,'X',L} end), %% OTP-9412 - ?line 8 = erl_scan:set_attribute(line, [{line,{nos,'X',8}}], - fun({nos,_V,VL}) -> VL end), + Attr30 = erl_scan:set_attribute(line, Attr20, + fun({nos,_V,VL}) -> VL end), + 8 = erl_anno:to_term(Attr30), ok. column_errors() -> @@ -812,7 +824,7 @@ white_spaces() -> {white_space,_," "}, {atom,_,a}, {white_space,_,"\n"}], - _} = erl_scan:string("\r a\n", {1,1}, return), + _} = erl_scan_string("\r a\n", {1,1}, return), ?line test("\r a\n"), L = "{\"a\nb\", \"a\\nb\",\nabc\r,def}.\n\n", ?line {ok,[{'{',_}, @@ -829,7 +841,7 @@ white_spaces() -> {'}',_}, {dot,_}, {white_space,_,"\n"}], - _} = erl_scan:string(L, {1,1}, return), + _} = erl_scan_string(L, {1,1}, return), ?line test(L), ?line test("\"\n\"\n"), ?line test("\n\r\n"), @@ -846,7 +858,7 @@ white_spaces() -> unicode() -> ?line {ok,[{char,1,83},{integer,1,45}],1} = - erl_scan:string("$\\12345"), % not unicode + erl_scan_string("$\\12345"), % not unicode ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string([1089]), @@ -858,7 +870,7 @@ unicode() -> erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), {ok,[{char,1,1}],1} = - erl_scan:string([$$,$\\,$^,1089], 1), + erl_scan_string([$$,$\\,$^,1089], 1), {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), @@ -870,13 +882,13 @@ unicode() -> erl_scan:string("'qa\\x{aaa}'",{1,1}), {ok,[{char,1,1089}],1} = - erl_scan:string([$$,1089], 1), + erl_scan_string([$$,1089], 1), {ok,[{char,1,1089}],1} = - erl_scan:string([$$,$\\,1089], 1), + erl_scan_string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", {ok,[{char,1,$\x{aaa}}],1} = - erl_scan:string(Qs, 1), + erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), [{category,char},{column,1},{length,8}, @@ -884,19 +896,19 @@ unicode() -> erl_scan:token_info(Q2), U1 = "\"\\x{aaa}\"", - {ok, - [{string,[{line,1},{column,1},{text,"\"\\x{aaa}\""}],[2730]}], - {1,10}} = erl_scan:string(U1, {1,1}, [text]), - {ok,[{string,1,[2730]}],1} = erl_scan:string(U1, 1), + {ok,[{string,A1,[2730]}],{1,10}} = erl_scan:string(U1, {1,1}, [text]), + [{line,1},{column,1},{text,"\"\\x{aaa}\""}] = + erl_scan:attributes_info(A1, [line, column, text]), + {ok,[{string,1,[2730]}],1} = erl_scan_string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", - {ok,[{string,1,[$\x41,$\x{fff},$\x42]}],1} = erl_scan:string(U2, 1), + {ok,[{string,1,[$\x41,$\x{fff},$\x42]}],1} = erl_scan_string(U2, 1), U3 = "\"a\n\\x{fff}\n\"", - {ok,[{string,1,[$a,$\n,$\x{fff},$\n]}],3} = erl_scan:string(U3, 1), + {ok,[{string,1,[$a,$\n,$\x{fff},$\n]}],3} = erl_scan_string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", - {ok,[{string,1,[$\n,$\x{aaa},$\n]}],3} = erl_scan:string(U4, 1), + {ok,[{string,1,[$\n,$\x{aaa},$\n]}],3} = erl_scan_string(U4, 1), %% Keep these tests: ?line test(Qs), @@ -906,15 +918,15 @@ unicode() -> ?line test(U4), Str1 = "\"ab" ++ [1089] ++ "cd\"", - {ok,[{string,1,[$a,$b,1089,$c,$d]}],1} = erl_scan:string(Str1, 1), + {ok,[{string,1,[$a,$b,1089,$c,$d]}],1} = erl_scan_string(Str1, 1), {ok,[{string,{1,1},[$a,$b,1089,$c,$d]}],{1,8}} = - erl_scan:string(Str1, {1,1}), + erl_scan_string(Str1, {1,1}), ?line test(Str1), Comment = "%% "++[1089], {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = - erl_scan:string(Comment, 1, [return]), + erl_scan_string(Comment, 1, [return]), {ok,[{comment,{1,1},[$%,$%,$\s,1089]}],{1,5}} = - erl_scan:string(Comment, {1,1}, [return]), + erl_scan_string(Comment, {1,1}, [return]), ok. more_chars() -> @@ -923,12 +935,12 @@ more_chars() -> %% All kinds of tests... ?line {ok,[{char,_,123}],{1,4}} = - erl_scan:string("$\\{",{1,1}), + erl_scan_string("$\\{",{1,1}), ?line {more, C1} = erl_scan:tokens([], "$\\{", {1,1}), ?line {done,{ok,[{char,_,123}],{1,4}},eof} = - erl_scan:tokens(C1, eof, 1), + erl_scan_tokens(C1, eof, 1), ?line {ok,[{char,1,123},{atom,1,a},{'}',1}],1} = - erl_scan:string("$\\{a}"), + erl_scan_string("$\\{a}"), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\x", {1,1}), @@ -993,11 +1005,11 @@ otp_10302(Config) when is_list(Config) -> {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089],1), + {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), + {ok,[{char,1,1089}],1} = erl_scan_string([$$,$\\,1089],1), Qs = "$\\x{aaa}", - {ok,[{char,1,2730}],1} = erl_scan:string(Qs,1), + {ok,[{char,1,2730}],1} = erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string(Qs,{1,1},[text]), [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = @@ -1011,19 +1023,19 @@ otp_10302(Config) when is_list(Config) -> {symbol,[16#aaa]},{text,U1}] = erl_scan:token_info(T1, Tags), U2 = "\"\\x41\\x{fff}\\x42\"", - {ok,[{string,1,[65,4095,66]}],1} = erl_scan:string(U2, 1), + {ok,[{string,1,[65,4095,66]}],1} = erl_scan_string(U2, 1), U3 = "\"a\n\\x{fff}\n\"", - {ok,[{string,1,[97,10,4095,10]}],3} = erl_scan:string(U3, 1), + {ok,[{string,1,[97,10,4095,10]}],3} = erl_scan_string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", - {ok,[{string,1,[10,2730,10]}],3} = erl_scan:string(U4, 1,[]), + {ok,[{string,1,[10,2730,10]}],3} = erl_scan_string(U4, 1,[]), Str1 = "\"ab" ++ [1089] ++ "cd\"", {ok,[{string,1,[97,98,1089,99,100]}],1} = - erl_scan:string(Str1,1), + erl_scan_string(Str1,1), {ok,[{string,{1,1},[97,98,1089,99,100]}],{1,8}} = - erl_scan:string(Str1, {1,1}), + erl_scan_string(Str1, {1,1}), OK1 = 16#D800-1, OK2 = 16#DFFF+1, @@ -1038,19 +1050,19 @@ otp_10302(Config) when is_list(Config) -> IllegalL = [Illegal1,Illegal2,Illegal3,Illegal4], [{ok,[{comment,1,[$%,$%,$\s,OK]}],1} = - erl_scan:string("%% "++[OK], 1, [return]) || + erl_scan_string("%% "++[OK], 1, [return]) || OK <- OKL], {ok,[{comment,_,[$%,$%,$\s,OK1]}],{1,5}} = - erl_scan:string("%% "++[OK1], {1,1}, [return]), + erl_scan_string("%% "++[OK1], {1,1}, [return]), [{error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("%% "++[Illegal], 1, [return]) || Illegal <- IllegalL], {error,{{1,1},erl_scan,{illegal,character}},{1,5}} = erl_scan:string("%% "++[Illegal1], {1,1}, [return]), - [{ok,[],1} = erl_scan:string("%% "++[OK], 1, []) || + [{ok,[],1} = erl_scan_string("%% "++[OK], 1, []) || OK <- OKL], - {ok,[],{1,5}} = erl_scan:string("%% "++[OK1], {1,1}, []), + {ok,[],{1,5}} = erl_scan_string("%% "++[OK1], {1,1}, []), [{error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("%% "++[Illegal], 1, []) || Illegal <- IllegalL], @@ -1058,7 +1070,7 @@ otp_10302(Config) when is_list(Config) -> erl_scan:string("%% "++[Illegal1], {1,1}, []), [{ok,[{string,{1,1},[OK]}],{1,4}} = - erl_scan:string("\""++[OK]++"\"",{1,1}) || + erl_scan_string("\""++[OK]++"\"",{1,1}) || OK <- OKL], [{error,{{1,2},erl_scan,{illegal,character}},{1,3}} = erl_scan:string("\""++[OK]++"\"",{1,1}) || @@ -1069,93 +1081,93 @@ otp_10302(Config) when is_list(Config) -> Illegal <- IllegalL], {ok,[{char,{1,1},OK1}],{1,3}} = - erl_scan:string([$$,OK1],{1,1}), + erl_scan_string([$$,OK1],{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([$$,Illegal1],{1,1}), {ok,[{char,{1,1},OK1}],{1,4}} = - erl_scan:string([$$,$\\,OK1],{1,1}), + erl_scan_string([$$,$\\,OK1],{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = erl_scan:string([$$,$\\,Illegal1],{1,1}), {ok,[{string,{1,1},[55295]}],{1,5}} = - erl_scan:string("\"\\"++[OK1]++"\"",{1,1}), + erl_scan_string("\"\\"++[OK1]++"\"",{1,1}), {error,{{1,2},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("\"\\"++[Illegal1]++"\"",{1,1}), {ok,[{char,{1,1},OK1}],{1,10}} = - erl_scan:string("$\\x{D7FF}",{1,1}), + erl_scan_string("$\\x{D7FF}",{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,10}} = erl_scan:string("$\\x{D800}",{1,1}), %% Not erl_scan, but erl_parse. - {integer,0,1} = erl_parse:abstract(1), - Float = 3.14, {float,0,Float} = erl_parse:abstract(Float), - {nil,0} = erl_parse:abstract([]), + {integer,0,1} = erl_parse_abstract(1), + Float = 3.14, {float,0,Float} = erl_parse_abstract(Float), + {nil,0} = erl_parse_abstract([]), {bin,0, [{bin_element,0,{integer,0,1},default,default}, {bin_element,0,{integer,0,2},default,default}]} = - erl_parse:abstract(<<1,2>>), + erl_parse_abstract(<<1,2>>), {cons,0,{tuple,0,[{atom,0,a}]},{atom,0,b}} = - erl_parse:abstract([{a} | b]), - {string,0,"str"} = erl_parse:abstract("str"), + erl_parse_abstract([{a} | b]), + {string,0,"str"} = erl_parse_abstract("str"), {cons,0, {integer,0,$a}, {cons,0,{integer,0,55296},{string,0,"c"}}} = - erl_parse:abstract("a"++[55296]++"c"), + erl_parse_abstract("a"++[55296]++"c"), Line = 17, - {integer,Line,1} = erl_parse:abstract(1, Line), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Line), - {nil,Line} = erl_parse:abstract([], Line), + {integer,Line,1} = erl_parse_abstract(1, Line), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Line), + {nil,Line} = erl_parse_abstract([], Line), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Line), + erl_parse_abstract(<<1,2>>, Line), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Line), - {string,Line,"str"} = erl_parse:abstract("str", Line), + erl_parse_abstract([{a} | b], Line), + {string,Line,"str"} = erl_parse_abstract("str", Line), {cons,Line, {integer,Line,$a}, {cons,Line,{integer,Line,55296},{string,Line,"c"}}} = - erl_parse:abstract("a"++[55296]++"c", Line), + erl_parse_abstract("a"++[55296]++"c", Line), Opts1 = [{line,17}], - {integer,Line,1} = erl_parse:abstract(1, Opts1), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Opts1), - {nil,Line} = erl_parse:abstract([], Opts1), + {integer,Line,1} = erl_parse_abstract(1, Opts1), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Opts1), + {nil,Line} = erl_parse_abstract([], Opts1), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Opts1), + erl_parse_abstract(<<1,2>>, Opts1), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Opts1), - {string,Line,"str"} = erl_parse:abstract("str", Opts1), + erl_parse_abstract([{a} | b], Opts1), + {string,Line,"str"} = erl_parse_abstract("str", Opts1), {cons,Line, {integer,Line,$a}, {cons,Line,{integer,Line,55296},{string,Line,"c"}}} = - erl_parse:abstract("a"++[55296]++"c", Opts1), + erl_parse_abstract("a"++[55296]++"c", Opts1), [begin - {integer,Line,1} = erl_parse:abstract(1, Opts2), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Opts2), - {nil,Line} = erl_parse:abstract([], Opts2), + {integer,Line,1} = erl_parse_abstract(1, Opts2), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Opts2), + {nil,Line} = erl_parse_abstract([], Opts2), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Opts2), + erl_parse_abstract(<<1,2>>, Opts2), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Opts2), - {string,Line,"str"} = erl_parse:abstract("str", Opts2), + erl_parse_abstract([{a} | b], Opts2), + {string,Line,"str"} = erl_parse_abstract("str", Opts2), {string,Line,[97,1024,99]} = - erl_parse:abstract("a"++[1024]++"c", Opts2) + erl_parse_abstract("a"++[1024]++"c", Opts2) end || Opts2 <- [[{encoding,unicode},{line,Line}], [{encoding,utf8},{line,Line}]]], {cons,0, {integer,0,97}, {cons,0,{integer,0,1024},{string,0,"c"}}} = - erl_parse:abstract("a"++[1024]++"c", [{encoding,latin1}]), + erl_parse_abstract("a"++[1024]++"c", [{encoding,latin1}]), ok. otp_10990(doc) -> @@ -1172,13 +1184,13 @@ otp_10992(suite) -> []; otp_10992(Config) when is_list(Config) -> {cons,0,{float,0,42.0},{nil,0}} = - erl_parse:abstract([42.0], [{encoding,unicode}]), + erl_parse_abstract([42.0], [{encoding,unicode}]), {cons,0,{float,0,42.0},{nil,0}} = - erl_parse:abstract([42.0], [{encoding,utf8}]), + erl_parse_abstract([42.0], [{encoding,utf8}]), {cons,0,{integer,0,65},{cons,0,{float,0,42.0},{nil,0}}} = - erl_parse:abstract([$A,42.0], [{encoding,unicode}]), + erl_parse_abstract([$A,42.0], [{encoding,unicode}]), {cons,0,{integer,0,65},{cons,0,{float,0,42.0},{nil,0}}} = - erl_parse:abstract([$A,42.0], [{encoding,utf8}]), + erl_parse_abstract([$A,42.0], [{encoding,utf8}]), ok. otp_11807(doc) -> @@ -1187,29 +1199,72 @@ otp_11807(suite) -> []; otp_11807(Config) when is_list(Config) -> {cons,0,{integer,0,97},{cons,0,{integer,0,98},{nil,0}}} = - erl_parse:abstract("ab", [{encoding,none}]), + erl_parse_abstract("ab", [{encoding,none}]), {cons,0,{integer,0,-1},{nil,0}} = - erl_parse:abstract([-1], [{encoding,latin1}]), + erl_parse_abstract([-1], [{encoding,latin1}]), ASCII = fun(I) -> I >= 0 andalso I < 128 end, - {string,0,"xyz"} = erl_parse:abstract("xyz", [{encoding,ASCII}]), + {string,0,"xyz"} = erl_parse_abstract("xyz", [{encoding,ASCII}]), {cons,0,{integer,0,228},{nil,0}} = - erl_parse:abstract([228], [{encoding,ASCII}]), + erl_parse_abstract([228], [{encoding,ASCII}]), {cons,0,{integer,0,97},{atom,0,a}} = - erl_parse:abstract("a"++a, [{encoding,latin1}]), + erl_parse_abstract("a"++a, [{encoding,latin1}]), {'EXIT', {{badarg,bad},_}} = % minor backward incompatibility (catch erl_parse:abstract("string", [{encoding,bad}])), ok. test_string(String, ExpectedWithCol) -> - {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + {ok, ExpectedWithCol, _EndWithCol} = erl_scan_string(String, {1, 1}, []), Expected = [ begin {L,_C} = element(2, T), setelement(2, T, L) end || T <- ExpectedWithCol ], - {ok, Expected, _End} = erl_scan:string(String), + {ok, Expected, _End} = erl_scan_string(String), test(String). +erl_scan_string(String) -> + erl_scan_string(String, 1, []). + +erl_scan_string(String, StartLocation) -> + erl_scan_string(String, StartLocation, []). + +erl_scan_string(String, StartLocation, Options) -> + case erl_scan:string(String, StartLocation, Options) of + {ok, Tokens, EndLocation} -> + {ok, unopaque_tokens(Tokens), EndLocation}; + Else -> + Else + end. + +erl_scan_tokens(C, S, L) -> + erl_scan_tokens(C, S, L, []). + +erl_scan_tokens(C, S, L, O) -> + case erl_scan:tokens(C, S, L, O) of + {done, {ok, Ts, End}, R} -> + {done, {ok, unopaque_tokens(Ts), End}, R}; + Else -> + Else + end. + +unopaque_tokens([]) -> + []; +unopaque_tokens([Token|Tokens]) -> + Attrs = element(2, Token), + Term = erl_anno:to_term(Attrs), + T = setelement(2, Token, Term), + [T | unopaque_tokens(Tokens)]. + +erl_parse_abstract(Term) -> + erl_parse_abstract(Term, []). + +erl_parse_abstract(Term, Options) -> + Abstr = erl_parse:abstract(Term, Options), + unopaque_abstract(Abstr). + +unopaque_abstract(Abstr) -> + erl_parse:anno_to_term(Abstr). + %% test_string(String, Expected, StartLocation, Options) -> %% {ok, Expected, _End} = erl_scan:string(String, StartLocation, Options), %% test(String). @@ -1359,7 +1414,7 @@ select_tokens(Tokens, Tags) -> simplify([Token|Tokens]) -> {line,Line} = erl_scan:token_info(Token, line), - [setelement(2, Token, Line) | simplify(Tokens)]; + [setelement(2, Token, erl_anno:new(Line)) | simplify(Tokens)]; simplify([]) -> []. 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/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 0a1b6dd2ba..348c308f5d 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -396,7 +396,8 @@ nomatch(Config) when is_list(Config) -> qlc:q([3 || {3=4} <- []]). ">>, [], - {warnings,[{{2,27},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,27},qlc,nomatch_pattern}]}}, + {warnings,[{2,v3_core,nomatch}]}}, {nomatch2, <<"nomatch() -> @@ -407,7 +408,8 @@ nomatch(Config) when is_list(Config) -> end, [{1},{2}]). ">>, [], - {warnings,[{{3,33},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,33},qlc,nomatch_pattern}]}}, + {warnings,[{3,v3_core,nomatch}]}}, {nomatch3, <<"nomatch() -> @@ -419,7 +421,8 @@ nomatch(Config) when is_list(Config) -> end, [{1,2},{2,3}]). ">>, [], - {warnings,[{{3,52},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,52},qlc,nomatch_pattern}]}}, + {warnings,[{3,v3_core,nomatch}]}}, {nomatch4, <<"nomatch() -> @@ -2487,8 +2490,11 @@ info(Config) when is_list(Config) -> (catch qlc:info([X || {X} <- []], {n_elements, 0})), L = lists:seq(1, 1000), \"[1,2,3,4,5,6,7,8,9,10|'...']\" = qlc:info(L, {n_elements, 10}), - {cons,1,{integer,1,1},{atom,1,'...'}} = + {cons,A1,{integer,A2,1},{atom,A3,'...'}} = qlc:info(L, [{n_elements, 1},{format,abstract_code}]), + 1 = erl_anno:line(A1), + 1 = erl_anno:line(A2), + 1 = erl_anno:line(A3), Q = qlc:q([{X} || X <- [a,b,c,d,e,f]]), {call,_,_,[{cons,_,{atom,_,a},{cons,_,{atom,_,b},{cons,_,{atom,_,c}, {atom,_,'...'}}}}, @@ -2905,7 +2911,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1},{a}])">>, - {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {X=X,Y=Y}={Y=Y,X=X} <- ets:table(E), @@ -2933,7 +2940,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a},{b}])">>, - {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -2941,7 +2949,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a},{b}])">>, - {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || X = <<X>> <- ets:table(E)]), @@ -2988,7 +2997,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a,b,c},{d,e,f}])">>, - {warnings,[{{2,34},qlc,nomatch_pattern}]}} + %% {warnings,[{{2,34},qlc,nomatch_pattern}]}} + []} ], ?line run(Config, Ts), @@ -3052,7 +3062,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,46},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,46},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3061,7 +3072,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,43},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,43},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3070,7 +3082,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,48},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,48},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([{X,Y} || {X,Y} <- ets:table(E), @@ -3085,7 +3098,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{[3]},{[3,4]}])">>, - {warnings,[{{2,61},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,61},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> U = 18, @@ -3117,7 +3131,8 @@ lookup2(Config) when is_list(Config) -> [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, - {warnings,[{{4,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,44},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3127,7 +3142,8 @@ lookup2(Config) when is_list(Config) -> [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, - {warnings,[{{4,35},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,35},qlc,nomatch_filter}]}}, + []}, <<"F = fun(U) -> Q = qlc:q([X || {X} <- [a,b,c], @@ -3143,7 +3159,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,1},{2,1}])">>, - {warnings,[{{2,61},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,61},qlc,nomatch_filter}]}}, + []}, <<"Two = 2.0, etsc(fun(E) -> @@ -3204,8 +3221,10 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,b},{2,3}])">>, + %% {warnings,[{2,sys_core_fold,nomatch_guard}, + %% {3,qlc,nomatch_filter}, + %% {3,sys_core_fold,{eval_failure,badarg}}]}}, {warnings,[{2,sys_core_fold,nomatch_guard}, - {3,qlc,nomatch_filter}, {3,sys_core_fold,{eval_failure,badarg}}]}}, <<"etsc(fun(E) -> @@ -3228,7 +3247,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{{1}},{{2}}])">>, - {warnings,[{{4,47},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,47},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3238,7 +3258,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{{1}},{{2}}])">>, - {warnings,[{{4,47},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,47},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), @@ -3298,7 +3319,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{3}, {4}])">>, - {warnings,[{{3,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,44},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), @@ -3703,7 +3725,8 @@ lookup_rec(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17}, #r{a = 3}, #r{a = 5}])">>, - {warnings,[{{4,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,44},qlc,nomatch_filter}]}}, + []}, <<"%% Compares an integer and a float. etsc(fun(E) -> @@ -4007,7 +4030,8 @@ skip_filters(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,1},{2,0}])">>, - {warnings,[{{4,37},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,37},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([{A,B,C} || @@ -6220,8 +6244,9 @@ otp_7238(Config) when is_list(Config) -> <<"nomatch_1() -> {qlc:q([X || X={X} <- []]), [t || \"a\"=\"b\" <- []]}.">>, [], - {warnings,[{{2,30},qlc,nomatch_pattern}, - {{2,44},v3_core,nomatch}]}}, + %% {warnings,[{{2,30},qlc,nomatch_pattern}, + %% {{2,44},v3_core,nomatch}]}}, + {warnings,[{2,v3_core,nomatch}]}}, %% Not found by qlc... {nomatch_2, @@ -6234,7 +6259,8 @@ otp_7238(Config) when is_list(Config) -> <<"nomatch_3() -> qlc:q([t || [$a, $b] = \"ba\" <- []]).">>, [], - {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + {warnings,[{2,v3_core,nomatch}]}}, %% Not found by qlc... {nomatch_4, @@ -6255,44 +6281,51 @@ otp_7238(Config) when is_list(Config) -> qlc:q([X || X <- [], X =:= {X}]).">>, [], - {warnings,[{{3,30},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,30},qlc,nomatch_filter}]}}, + []}, {nomatch_7, <<"nomatch_7() -> qlc:q([X || {X=Y,{Y}=X} <- []]).">>, [], - {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + []}, {nomatch_8, <<"nomatch_8() -> qlc:q([X || {X={},X=[]} <- []]).">>, [], - {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + []}, {nomatch_9, <<"nomatch_9() -> qlc:q([X || X <- [], X =:= {}, X =:= []]).">>, [], - {warnings,[{{2,49},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,49},qlc,nomatch_filter}]}}, + []}, {nomatch_10, <<"nomatch_10() -> qlc:q([X || X <- [], ((X =:= 1) or (X =:= 2)) and (X =:= 3)]).">>, [], - {warnings,[{{3,53},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,53},qlc,nomatch_filter}]}}, + []}, {nomatch_11, <<"nomatch_11() -> qlc:q([X || X <- [], x =:= []]).">>, [], - {warnings,[{{2,39},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,39},qlc,nomatch_filter}]}}, + {warnings,[{2,sys_core_fold,nomatch_guard}]}}, {nomatch_12, <<"nomatch_12() -> qlc:q([X || X={} <- [], X =:= []]).">>, [], - {warnings,[{{2,42},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,42},qlc,nomatch_filter}]}}, + []}, {nomatch_13, <<"nomatch_13() -> @@ -6300,8 +6333,9 @@ otp_7238(Config) when is_list(Config) -> X={X} <- [], Y={Y} <- []]).">>, [], - {warnings,[{{3,29},qlc,nomatch_pattern}, - {{4,29},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,29},qlc,nomatch_pattern}, + %% {{4,29},qlc,nomatch_pattern}]}}, + []}, {nomatch_14, <<"nomatch_14() -> @@ -6309,7 +6343,8 @@ otp_7238(Config) when is_list(Config) -> 1 > 0, 1 > X]).">>, [], - {warnings,[{{2,29},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,29},qlc,nomatch_pattern}]}}, + []}, {nomatch_15, <<"nomatch_15() -> @@ -6318,7 +6353,8 @@ otp_7238(Config) when is_list(Config) -> 1 > 0, 1 > X]).">>, [], - {warnings,[{{2,32},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,32},qlc,nomatch_pattern}]}}, + []}, %% Template warning. {nomatch_template1, @@ -6556,18 +6592,19 @@ otp_7238(Config) when is_list(Config) -> ?line run(Config, T2), T3 = [ - {nomatch_6, - <<"nomatch_6() -> - qlc:q([X || X <- [], - X =:= {X}]).">>, - [], - {[],["filter evaluates to 'false'"]}}, - - {nomatch_7, - <<"nomatch_7() -> - qlc:q([X || {X=Y,{Y}=X} <- []]).">>, - [], - {[],["pattern cannot possibly match"]}}], +%% {nomatch_6, +%% <<"nomatch_6() -> +%% qlc:q([X || X <- [], +%% X =:= {X}]).">>, +%% [], +%% {[],["filter evaluates to 'false'"]}}, + +%% {nomatch_7, +%% <<"nomatch_7() -> +%% qlc:q([X || {X=Y,{Y}=X} <- []]).">>, +%% [], +%% {[],["pattern cannot possibly match"]}} + ], ?line compile_format(Config, T3), %% *Very* simple test - just check that it doesn't crash. @@ -6825,7 +6862,8 @@ otp_6674(Config) when is_list(Config) -> A == 192, B =:= 192.0, {Y} <- [{0},{1},{2}], X == Y]), - {block,0, + A0 = erl_anno:new(0), + {block,A0, [{match,_,_, {call,_,_, [{lc,_,_, @@ -7395,7 +7433,8 @@ try_old_join_info(Config) -> {ok, M} = compile:file(File, [{outdir, ?datadir}]), {module, M} = code:load_abs(filename:rootname(File)), H = M:create_handle(), - {block,0, + A0 = erl_anno:new(0), + {block,A0, [{match,_,_, {call,_,_, [{lc,_,_, @@ -7775,8 +7814,8 @@ table(List, Indices, KeyPos, ParentFun) -> end, FormatFun = fun(all) -> - L = 17, - {call,L,{remote,L,{atom,1,?MODULE},{atom,L,the_list}}, + L = erl_anno:new(17), + {call,L,{remote,L,{atom,L,?MODULE},{atom,L,the_list}}, [erl_parse:abstract(List, 17)]}; ({lookup, Column, Values}) -> {?MODULE, list_keys, [Values, Column, List]} 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/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index f841e2c4a6..7c18560498 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_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 @@ -404,13 +404,14 @@ records(Config) when is_list(Config) -> ?line ok = file:write_file(Test, Contents), RR5 = "rr(\"" ++ Test ++ "\", '_', {d,test1}), rl([test1,test2]).", - ?line [{attribute,1,record,{test1,_}},ok] = scan(RR5), + A1 = erl_anno:new(1), + [{attribute,A1,record,{test1,_}},ok] = scan(RR5), RR6 = "rr(\"" ++ Test ++ "\", '_', {d,test2}), rl([test1,test2]).", - ?line [{attribute,1,record,{test2,_}},ok] = scan(RR6), + [{attribute,A1,record,{test2,_}},ok] = scan(RR6), RR7 = "rr(\"" ++ Test ++ "\", '_', [{d,test1},{d,test2,17}]), rl([test1,test2]).", - ?line [{attribute,1,record,{test1,_}},{attribute,1,record,{test2,_}}, - ok] = scan(RR7), + [{attribute,A1,record,{test1,_}},{attribute,A1,record,{test2,_}},ok] = + scan(RR7), ?line PreReply = scan(<<"rr(prim_file).">>), % preloaded... ?line true = is_list(PreReply), ?line Dir = filename:join(?config(priv_dir, Config), "*.erl"), diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 3ca7a8197e..39c522fd11 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -454,7 +454,7 @@ io_error(L, Desc) -> {L, ?MODULE, Desc}. start_pos([T | _Ts], _L) -> - element(2, T); + erl_anno:line(element(2, T)); start_pos([], L) -> L. diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 7b2f9f7adb..72e1e2d2f5 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -123,7 +123,6 @@ recomment_forms(Tree, Cs, Insert) -> form_list -> Tree1 = erl_syntax:flatten_form_list(Tree), Node = build_tree(Tree1), - %% Here we make a small assumption about the substructure of %% a `form_list' tree: it has exactly one group of subtrees. [Node1] = node_subtrees(Node), @@ -753,7 +752,13 @@ get_line(Node) -> {_, L, _} when is_integer(L) -> L; Pos -> - exit({bad_position, Pos}) + try erl_anno:line(Pos) of + Line -> + Line + catch + _:_ -> + exit({bad_position, Pos}) + end end. diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile index 8c7fa99886..421079ac94 100644 --- a/lib/test_server/doc/src/Makefile +++ b/lib/test_server/doc/src/Makefile @@ -27,6 +27,10 @@ include ../../vsn.mk VSN=$(TEST_SERVER_VSN) APPLICATION=test_server +DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ +The Test Server application is obsolete and will be removed \ +in the next major OTP release + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- 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/notes.xml b/lib/test_server/doc/src/notes.xml index f21c32a304..e996d2b4a3 100644 --- a/lib/test_server/doc/src/notes.xml +++ b/lib/test_server/doc/src/notes.xml @@ -32,6 +32,28 @@ <file>notes.xml</file> </header> +<section><title>Test_Server 3.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If the last expression in a test case causes a timetrap + timeout, the stack trace is ignored and not printed to + the test case log file. This happens because the + {Suite,TestCase,Line} info is not available in the stack + trace in this scenario, due to tail call elimination. + Common Test has been modified to handle this situation by + inserting a {Suite,TestCase,last_expr} tuple in the + correct place and printing the stack trace as expected.</p> + <p> + Own Id: OTP-12697 Aux Id: seq12848 </p> + </item> + </list> + </section> + +</section> + <section><title>Test_Server 3.8</title> <section><title>Fixed Bugs and Malfunctions</title> 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 7cfaa2c325..2e443c7b8b 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. 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 @@ -117,9 +117,11 @@ parse_preprocessed_file(Epp,File,InCorrectFile) -> parse_preprocessed_file(Epp,File,true); {attribute,_,file,{_OtherFile,_}} -> parse_preprocessed_file(Epp,File,false); - {function,L,F,A,[_|C]} when InCorrectFile -> - Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], - [{atom_to_list(F),A,L} | Clauses] ++ + {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); _ -> parse_preprocessed_file(Epp,File,InCorrectFile) @@ -146,9 +148,11 @@ parse_non_preprocessed_file(Epp, File, Location) -> case epp_dodger:parse_form(Epp, Location) of {ok,Tree,Location1} -> try erl_syntax:revert(Tree) of - {function,L,F,A,[_|C]} -> - Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], - [{atom_to_list(F),A,L} | Clauses] ++ + {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] ++ parse_non_preprocessed_file(Epp, File, Location1); _ -> parse_non_preprocessed_file(Epp, File, Location1) @@ -161,23 +165,52 @@ parse_non_preprocessed_file(Epp, File, Location) -> [] end. +get_line(Anno) -> + erl_anno: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}; + _ -> + {lists:reverse([{clause,CL}|CLs]), CL} + catch + _:_ -> + {lists:reverse([{clause,CL}|CLs]), CL} + end; + +find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> + find_clause_lines(Cs, [{clause,CL}|CLs]). + %%%----------------------------------------------------------------- %%% Add a link target for each line and one for each function definition. -build_html(SFd,DFd,Encoding,Functions) -> - build_html(SFd,DFd,Encoding,file:read_line(SFd),1,Functions,false). +build_html(SFd,DFd,Encoding,FuncsAndCs) -> + build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs, + false,undefined). -build_html(SFd,DFd,Encoding,{ok,Str},L,[{F,A,L}|Functions],_IsFuncDef) -> +%% 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,Encoding),"\"/>"]), - build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true); -build_html(SFd,DFd,Encoding,{ok,Str},L,[{clause,L}|Functions],_IsFuncDef) -> - build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true); -build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,IsFuncDef) -> + 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); +build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs], + _IsFuncDef,FAndLastL) -> + build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL); +build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) -> LStr = line_number(L), Str1 = line(Str,IsFuncDef), file:write(DFd,[LStr,Str1]), - build_html(SFd,DFd,Encoding,file:read_line(SFd),L+1,Functions,false); -build_html(_SFd,_DFd,_Encoding,eof,L,_Functions,_IsFuncDef) -> + build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL); +build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) -> L. line_number(L) -> diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7f2da7755a..785e687b92 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1313,12 +1313,30 @@ get_loc(Pid) -> Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], case get(test_server_loc) of [{Suite,Case}] -> - %% location info unknown, check if {Suite,Case,Line} - %% is available in stacktrace. and if so, use stacktrace - %% instead of current test_server_loc + %% Location info unknown, check if {Suite,Case,Line} + %% is available in stacktrace and if so, use stacktrace + %% instead of current test_server_loc. + %% If location is the last expression in a test case + %% function, the info is not available due to tail call + %% elimination. We need to check if the test case has been + %% called by ts_tc/3 and, if so, insert the test case info + %% at that position. case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of - [match|_] -> put(test_server_loc, Stk); - _ -> ok + [match|_] -> + put(test_server_loc, Stk); + _ -> + {PreTC,PostTC} = + lists:splitwith(fun({test_server,ts_tc,_}) -> + false; + (_) -> + true + end, Stk), + if PostTC == [] -> + ok; + true -> + put(test_server_loc, + PreTC++[{Suite,Case,last_expr} | PostTC]) + end end; _ -> put(test_server_loc, Stk) @@ -1380,7 +1398,10 @@ lookup_config(Key,Config) -> undefined end. -%% timer:tc/3 +%% +%% IMPORTANT: get_loc/1 uses the name of this function when analysing +%% stack traces. If the name changes, get_loc/1 must be updated! +%% ts_tc(M, F, A) -> Before = erlang:monotonic_time(), Result = try @@ -2470,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/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index bef0658b6d..d0c8a1ebe8 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -4776,17 +4776,25 @@ collect_case_subcases(Mod, Case, SubCases, St0, Mode) -> collect_files(Dir, Pattern, St, Mode) -> {ok,Cwd} = file:get_cwd(), Dir1 = filename:join(Cwd, Dir), - Wc = filename:join([Dir1,Pattern++code:objfile_extension()]), + Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]), case catch filelib:wildcard(Wc) of {'EXIT', Reason} -> io:format("Could not collect files: ~p~n", [Reason]), {error,{collect_fail,Dir,Pattern}}; - Mods0 -> - Mods = [{path_to_module(Mod),all} || Mod <- lists:sort(Mods0)], - collect_cases(Mods, St, Mode) + Files -> + %% convert to module names and remove duplicates + Mods = lists:foldl(fun(File, Acc) -> + Mod = fullname_to_mod(File), + case lists:member(Mod, Acc) of + true -> Acc; + false -> [Mod | Acc] + end + end, [], Files), + Tests = [{Mod,all} || Mod <- lists:sort(Mods)], + collect_cases(Tests, St, Mode) end. -path_to_module(Path) when is_list(Path) -> +fullname_to_mod(Path) when is_list(Path) -> %% If this is called with a binary, then we are probably in +fnu %% mode and have found a beam file with name encoded as latin1. We %% will let this crash since it can not work to load such a module diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 7a1f7803eb..7d92bc902a 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -61,33 +61,37 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) -> TruncTO = trunc(Timeout), receive after TruncTO -> - case is_process_alive(Pid) of - true -> - TimeToReport = if Timeout0 == ReportTVal -> TruncTO; - true -> ReportTVal end, - MFLs = test_server:get_loc(Pid), - Mon = erlang:monitor(process, Pid), - Trap = {timetrap_timeout,TimeToReport,MFLs}, - exit(Pid, Trap), - receive - {'DOWN', Mon, process, Pid, _} -> - ok - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - catch error_logger:warning_msg( - "Testcase process ~w not " - "responding to timetrap " - "timeout:~n" - " ~p.~n" - "Killing testcase...~n", - [Pid, Trap]), - exit(Pid, kill) - end; - false -> + kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) + end. + +kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) -> + case is_process_alive(Pid) of + true -> + TimeToReport = if Timeout0 == ReportTVal -> TruncTO; + true -> ReportTVal end, + MFLs = test_server:get_loc(Pid), + Mon = erlang:monitor(process, Pid), + Trap = {timetrap_timeout,TimeToReport,MFLs}, + exit(Pid, Trap), + receive + {'DOWN', Mon, process, Pid, _} -> ok - end + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + catch error_logger:warning_msg( + "Testcase process ~w not " + "responding to timetrap " + "timeout:~n" + " ~p.~n" + "Killing testcase...~n", + [Pid, Trap]), + exit(Pid, kill) + end; + false -> + ok end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap_cancel(Handle) -> ok %% Handle = term() @@ -806,10 +810,19 @@ format_loc1({Mod,Func,Line}) -> case {lists:member(no_src, get(test_server_logopts)), lists:reverse(ModStr)} of {false,[$E,$T,$I,$U,$S,$_|_]} -> - io_lib:format("{~w,~w,<a href=\"~ts~ts#~w\">~w</a>}", + Link = if is_integer(Line) -> + integer_to_list(Line); + Line == last_expr -> + list_to_atom(atom_to_list(Func)++"-last_expr"); + is_atom(Line) -> + atom_to_list(Line); + true -> + Line + end, + io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}", [Mod,Func, test_server_ctrl:uri_encode(downcase(ModStr)), - ?src_listing_ext,Line,Line]); + ?src_listing_ext,Link,Line]); _ -> io_lib:format("{~w,~w,~w}",[Mod,Func,Line]) end. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index d6d2e865e2..469593e947 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -24,15 +24,20 @@ -module(ts). --export([run/0, run/1, run/2, run/3, run/4, run/5, - tests/0, tests/1, +-export([cl_run/1, + run/0, run/1, run/2, run/3, run/4, run/5, + run_category/1, run_category/2, run_category/3, + tests/0, tests/1, suites/1, categories/1, install/0, install/1, - bench/0, bench/1, bench/2, benchmarks/0, - smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0, estone/0, estone/1, cross_cover_analyse/1, compile_testcases/0, compile_testcases/1, help/0]). + +%% Functions kept for backwards compatibility +-export([bench/0, bench/1, bench/2, benchmarks/0, + smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0]). + -export([i/0, l/1, r/0, r/1, r/2, r/3]). %%%---------------------------------------------------------------------- @@ -82,10 +87,13 @@ -define( install_help, [ - " ts:install() - Install TS with no Options.\n" - " ts:install([Options]) - Install TS with Options\n" + " ts:install()\n", + " Install ts with no options.\n", + "\n", + " ts:install(Options)\n", + " Install ts with a list of options, see below.\n", "\n", - "Installation options supported:\n", + "Installation options supported:\n\n", " {longnames, true} - Use fully qualified hostnames\n", " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n" " quiet(default).\n" @@ -110,21 +118,64 @@ help() -> end. help(uninstalled) -> - H = ["TS is not installed yet. To install use:\n\n"], + H = ["ts is not yet installed. To install use:\n\n"], show_help([H,?install_help]); help(installed) -> - H = ["Run functions:\n", - " ts:run() - Run all available tests.\n", - " ts:run(Spec) - Run all tests in given test spec file.\n", - " The spec file is actually ../*_test/Spec.spec\n", - " ts:run([Specs]) - Run all tests in all given test spec files.\n", - " ts:run(Spec, Mod) - Run a single test suite.\n", - " ts:run(Spec, Mod, Case)\n", - " - Run a single test case.\n", - " All above run functions can have an additional Options argument\n", - " which is a list of options.\n", + H = ["\n", + "Run functions:\n\n", + " ts:run()\n", + " Run the tests for all apps. The tests are defined by the\n", + " main test specification for each app: ../App_test/App.spec.\n", + "\n", + " ts:run(Apps)\n", + " Apps = atom() | [atom()]\n", + " Run the tests for an app, or set of apps. The tests are\n", + " defined by the main test specification for each app:\n", + " ../App_test/App.spec.\n", + "\n", + " ts:run(App, Suites)\n", + " App = atom(), Suites = atom() | [atom()]\n", + " Run one or more test suites for App (i.e. modules named\n", + " *_SUITE.erl, located in ../App_test/).\n", + "\n", + " ts:run(App, Suite, TestCases)\n", + " App = atom(), Suite = atom(),\n", + " TestCases = TCs | {testcase,TCs}, TCs = atom() | [atom()]\n", + " Run one or more test cases (functions) in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Groups})\n", + " App = atom(), Suite = atom(), Groups = atom() | [atom()]\n", + " Run one or more test case groups in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Group}, {testcase,TestCases})\n", + " App = atom(), Suite = atom(), Group = atom(),\n", + " TestCases = atom() | [atom()]\n", + " Run one or more test cases in a test case group in Suite.\n", + "\n", + " ts:run_category(TestCategory)\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for all apps.\n", + " For each app, the tests are defined by the specification:\n", + " ../App_test/App_TestCategory.spec.\n", + "\n", + " ts:run_category(Apps, TestCategory)\n", + " Apps = atom() | [atom()],\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for the given app or apps.\n", "\n", - "Run options supported:\n", + " Note that the test category parameter may have arbitrary value,\n", + " but should correspond to an existing test specification with file\n", + " name: ../App_test/App_TestCategory.spec.\n", + " Predefined categories exist for smoke tests, essential tests and\n", + " benchmark tests. The corresponding specs are:\n", + " ../*_test/Spec_smoke.spec, ../*_test/Spec_essential.spec and\n", + " ../*_test/Spec_bench.spec.\n", + "\n", + " All above run functions can take an additional last argument,\n", + " Options, which is a list of options (e.g. ts:run(App, Options),\n", + " or ts:run_category(Apps, TestCategory, Options)).\n", + "\n", + "Run options supported:\n\n", " batch - Do not start a new xterm\n", " {verbose, Level} - Same as the verbosity option for install\n", " verbose - Same as {verbose, 1}\n", @@ -143,47 +194,46 @@ help(installed) -> " files are. The default location is\n" " tests/test_server/.\n" "\n", - "Supported trace information elements\n", + "Supported trace information elements:\n\n", " {tp | tpl, Mod, [] | match_spec()}\n", " {tp | tpl, Mod, Func, [] | match_spec()}\n", " {tp | tpl, Mod, Func, Arity, [] | match_spec()}\n", " {ctp | ctpl, Mod}\n", " {ctp | ctpl, Mod, Func}\n", " {ctp | ctpl, Mod, Func, Arity}\n", + "\n\n", + "Support functions:\n\n", + " ts:tests()\n", + " Returns all apps available for testing.\n", + "\n", + " ts:tests(TestCategory)\n", + " Returns all apps that provide tests in the given category.\n", + "\n", + " ts:suites(App)\n", + " Returns all available test suites for App,\n", + " i.e. ../App_test/*_SUITE.erl\n", + "\n", + " ts:categories(App)\n", + " Returns all test categories available for App.\n", "\n", - "Support functions:\n", - " ts:tests() - Shows all available families of tests.\n", - " ts:tests(Spec) - Shows all available test modules in Spec,\n", - " i.e. ../Spec_test/*_SUITE.erl\n", - " ts:estone() - Run estone_SUITE in kernel application with\n" - " no run options\n", - " ts:estone(Opts) - Run estone_SUITE in kernel application with\n" - " the given run options\n", - " ts:cross_cover_analyse(Level)\n" - " - Used after ts:run with option cover or \n" - " cover_details. Analyses modules specified with\n" - " a 'cross' statement in the cover spec file.\n" - " Level can be 'overview' or 'details'.\n", - " ts:compile_testcases()~n" - " ts:compile_testcases(Apps)~n" - " - Compile all testcases for usage in a cross ~n" - " compile environment." - " \n" - "Benchmark functions:\n" - " ts:benchmarks() - Get all available families of benchmarks\n" - " ts:bench() - Runs all benchmarks\n" - " ts:bench(Spec) - Runs all benchmarks in the given spec file.\n" - " The spec file is actually ../*_test/Spec_bench.spec\n\n" - " ts:bench can take the same Options argument as ts:run.\n" - "Smoke test functions:\n" - " ts:smoke_tests() - Get all available families of smoke tests\n" - " ts:smoke_test() - Runs all smoke tests\n" - " ts:smoke_test(Spec)\n" - " - Runs all smoke tests in the given spec file.\n" - " The spec file is actually ../*_test/Spec_smoke.spec\n\n" - " ts:smoke_test can take the same Options argument as ts:run.\n" - "\n" - "Installation (already done):\n" + " ts:estone()\n", + " Runs estone_SUITE in the kernel application with no run options\n", + "\n", + " ts:estone(Opts)\n", + " Runs estone_SUITE in the kernel application with the given\n", + " run options\n", + "\n", + " ts:cross_cover_analyse(Level)\n", + " Use after ts:run with option cover or cover_details. Analyses\n", + " modules specified with a 'cross' statement in the cover spec file.\n", + " Level can be 'overview' or 'details'.\n", + "\n", + " ts:compile_testcases()\n", + " ts:compile_testcases(Apps)\n", + " Compiles all test cases for the given apps, for usage in a\n", + " cross compilation environment.\n", + "\n\n", + "Installation (already done):\n\n" ], show_help([H,?install_help]). @@ -212,86 +262,128 @@ run_all(_Vars) -> run_some([], _Opts) -> ok; -run_some([{Spec,Mod}|Specs], Opts) -> - case run(Spec, Mod, Opts) of +run_some([{App,Mod}|Apps], Opts) -> + case run(App, Mod, Opts) of ok -> ok; - Error -> io:format("~p: ~p~n",[{Spec,Mod},Error]) + Error -> io:format("~p: ~p~n",[{App,Mod},Error]) end, - run_some(Specs, Opts); -run_some([Spec|Specs], Opts) -> - case run(Spec, Opts) of + run_some(Apps, Opts); +run_some([App|Apps], Opts) -> + case run(App, Opts) of ok -> ok; - Error -> io:format("~p: ~p~n",[Spec,Error]) + Error -> io:format("~p: ~p~n",[App,Error]) end, - run_some(Specs, Opts). + run_some(Apps, Opts). + +%% This can be used from command line. Both App and +%% TestCategory must be specified. App may be 'all' +%% and TestCategory may be 'main'. Examples: +%% erl -s ts cl_run kernel smoke <options> +%% erl -s ts cl_run kernel main <options> +%% erl -s ts cl_run all essential <options> +%% erl -s ts cl_run all main <options> +%% When using the 'main' category and running with cover, +%% one can also use the cross_cover_analysis flag. +cl_run([App,Cat|Options0]) when is_atom(App) -> -%% Runs one test spec (interactive). -run(Testspec) when is_atom(Testspec) -> - Options=check_test_get_opts(Testspec, []), - File = atom_to_list(Testspec), - run_test(File, [{spec,[File++".spec"]}], Options); - -%% This can be used from command line, e.g. -%% erl -s ts run all_tests <config> -%% When using the all_tests flag and running with cover, one can also -%% use the cross_cover_analysis flag. -run([all_tests|Config0]) -> AllAtomsFun = fun(X) when is_atom(X) -> true; (_) -> false end, - Config1 = - case lists:all(AllAtomsFun,Config0) of + Options1 = + case lists:all(AllAtomsFun, Options0) of true -> %% Could be from command line - lists:map(fun(Conf)->to_erlang_term(Conf) end,Config0)--[batch]; + lists:map(fun(Opt) -> + to_erlang_term(Opt) + end, Options0) -- [batch]; false -> - Config0--[batch] + Options0 -- [batch] end, %% Make sure there is exactly one occurence of 'batch' - Config2 = [batch|Config1], - - R = run(tests(),Config2), - - case check_for_cross_cover_analysis_flag(Config2) of + Options2 = [batch|Options1], + + Result = + case {App,Cat} of + {all,main} -> + run(tests(), Options2); + {all,Cat} -> + run_category(Cat, Options2); + {_,main} -> + run(App, Options2); + {_,Cat} -> + run_category(App, Cat, Options2) + end, + case check_for_cross_cover_analysis_flag(Options2) of false -> ok; Level -> cross_cover_analyse(Level) end, + Result. - R; +%% run/1 +%% Runs tests for one app (interactive). +run(App) when is_atom(App) -> + Options = check_test_get_opts(App, []), + File = atom_to_list(App), + run_test(File, [{spec,[File++".spec"]},{allow_user_terms,true}], Options); -%% ts:run(ListOfTests) -run(List) when is_list(List) -> - run(List, [batch]). - -run(List, Opts) when is_list(List), is_list(Opts) -> - run_some(List, Opts); +%% This can be used from command line, e.g. +%% erl -s ts run all <options> +%% erl -s ts run main <options> +run([all,main|Opts]) -> + cl_run([all,main|Opts]); +run([all|Opts]) -> + cl_run([all,main|Opts]); +run([main|Opts]) -> + cl_run([all,main|Opts]); +%% Backwards compatible +run([all_tests|Opts]) -> + cl_run([all,main|Opts]); + +%% run/1 +%% Runs the main tests for all available apps +run(Apps) when is_list(Apps) -> + run(Apps, [batch]). %% run/2 -%% Runs one test spec with list of suites or with options -run(Testspec, ModsOrConfig) when is_atom(Testspec), - is_list(ModsOrConfig) -> - case is_list_of_suites(ModsOrConfig) of +%% Runs the main tests for all available apps +run(Apps, Opts) when is_list(Apps), is_list(Opts) -> + run_some(Apps, Opts); + +%% Runs tests for one app with list of suites or with options +run(App, ModsOrOpts) when is_atom(App), + is_list(ModsOrOpts) -> + case is_list_of_suites(ModsOrOpts) of false -> - run(Testspec, {config_list,ModsOrConfig}); + run(App, {opts_list,ModsOrOpts}); true -> - run_some([{Testspec,M} || M <- ModsOrConfig], + run_some([{App,M} || M <- ModsOrOpts], [batch]) end; -run(Testspec, {config_list,Config}) -> - Options=check_test_get_opts(Testspec, Config), - IsSmoke=proplists:get_value(smoke,Config), - File=atom_to_list(Testspec), + +run(App, {opts_list,Opts}) -> + Options = check_test_get_opts(App, Opts), + File = atom_to_list(App), + + %% check if other test category than main has been specified + {CatSpecName,TestCat} = + case proplists:get_value(test_category, Opts) of + undefined -> + {"",main}; + Cat -> + {"_" ++ atom_to_list(Cat),Cat} + end, + WhatToDo = - case Testspec of + case App of %% Known to exist but fails generic tests below emulator -> test; system -> test; erl_interface -> test; epmd -> test; _ -> - case code:lib_dir(Testspec) of + case code:lib_dir(App) of {error,bad_name} -> %% Application does not exist skip; @@ -313,92 +405,167 @@ run(Testspec, {config_list,Config}) -> end end end, - Spec = - case WhatToDo of - skip -> - create_skip_spec(Testspec, tests(Testspec)); - test when IsSmoke -> - File++"_smoke.spec"; - test -> - File++".spec" - end, - run_test(File, [{spec,[Spec]}], Options); -%% Runs one module in a spec (interactive) -run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> - run_test({atom_to_list(Testspec),Mod}, + case WhatToDo of + skip -> + SkipSpec = create_skip_spec(App, suites(App)), + run_test(File, [{spec,[SkipSpec]}], Options); + test when TestCat == bench -> + check_and_run(fun(Vars) -> + ts_benchmark:run([App], Options, Vars) + end); + test -> + Spec = File ++ CatSpecName ++ ".spec", + run_test(File, [{spec,[Spec]},{allow_user_terms,true}], Options) + end; + +%% Runs one module for an app (interactive) +run(App, Mod) when is_atom(App), is_atom(Mod) -> + run_test({atom_to_list(App),Mod}, [{suite,Mod}], [interactive]). %% run/3 -%% Run one module in a spec with Config -run(Testspec, Mod, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), - run_test({atom_to_list(Testspec),Mod}, +%% Run one module for an app with Opts +run(App, Mod, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + run_test({atom_to_list(App),Mod}, [{suite,Mod}], Options); -%% Run multiple modules with Config -run(Testspec, Mods, Config) when is_atom(Testspec), - is_list(Mods), - is_list(Config) -> - run_some([{Testspec,M} || M <- Mods], Config); + +%% Run multiple modules with Opts +run(App, Mods, Opts) when is_atom(App), + is_list(Mods), + is_list(Opts) -> + run_some([{App,M} || M <- Mods], Opts); + %% Runs one test case in a module. -run(Testspec, Mod, Case) when is_atom(Testspec), - is_atom(Mod), - is_atom(Case) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, Case) when is_atom(App), + is_atom(Mod), + is_atom(Case) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Runs one or more groups in a module. -run(Testspec, Mod, Grs={group,_Groups}) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, Grs={group,_Groups}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},Grs], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Runs one or more test cases in a module. -run(Testspec, Mod, TCs={testcase,_Cases}) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, TCs={testcase,_Cases}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},TCs], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). %% run/4 %% Run one test case in a module with Options. -run(Testspec, Mod, Case, Config) when is_atom(Testspec), - is_atom(Mod), - is_atom(Case), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, Case, Opts) when is_atom(App), + is_atom(Mod), + is_atom(Case), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Run one or more test cases in a module with Options. -run(Testspec, Mod, {testcase,Cases}, Config) when is_atom(Testspec), - is_atom(Mod) -> - run(Testspec, Mod, Cases, Config); -run(Testspec, Mod, Cases, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Cases), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, {testcase,Cases}, Opts) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Cases, Opts); +run(App, Mod, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Cases), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Cases], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + +%% Run one or more test cases in a group. +run(App, Mod, Gr={group,_Group}, {testcase,Cases}) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Gr, Cases, [batch]); + + %% Run one or more groups in a module with Options. -run(Testspec, Mod, Grs={group,_Groups}, Config) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, Grs={group,_Groups}, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Grs], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). %% run/5 %% Run one or more test cases in a group with Options. -run(Testspec, Mod, Group, Cases, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Config) -> +run(App, Mod, Group, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> Group1 = if is_tuple(Group) -> Group; true -> {group,Group} end, Cases1 = if is_tuple(Cases) -> Cases; true -> {testcase,Cases} end, - Options=check_test_get_opts(Testspec, Config), + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Group1,Cases1], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). + +%% run_category/1 +run_category(TestCategory) when is_atom(TestCategory) -> + run_category(TestCategory, [batch]). + +%% run_category/2 +run_category(TestCategory, Opts) when is_atom(TestCategory), + is_list(Opts) -> + case ts:tests(TestCategory) of + [] -> + {error, no_tests_available}; + Apps -> + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1) + end; + +run_category(Apps, TestCategory) when is_atom(TestCategory) -> + run_category(Apps, TestCategory, [batch]). + +%% run_category/3 +run_category(App, TestCategory, Opts) -> + Apps = if is_atom(App) -> [App]; + is_list(App) -> App + end, + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1). + +%%----------------------------------------------------------------- +%% Functions kept for backwards compatibility + +bench() -> + run_category(bench, []). +bench(Opts) when is_list(Opts) -> + run_category(bench, Opts); +bench(App) -> + run_category(App, bench, []). +bench(App, Opts) when is_atom(App) -> + run_category(App, bench, Opts); +bench(Apps, Opts) when is_list(Apps) -> + run_category(Apps, bench, Opts). + +benchmarks() -> + tests(bench). + +smoke_test() -> + run_category(smoke, []). +smoke_test(Opts) when is_list(Opts) -> + run_category(smoke, Opts); +smoke_test(App) -> + run_category(App, smoke, []). +smoke_test(App, Opts) when is_atom(App) -> + run_category(App, smoke, Opts); +smoke_test(Apps, Opts) when is_list(Apps) -> + run_category(Apps, smoke, Opts). + +smoke_tests() -> + tests(smoke). + +%%----------------------------------------------------------------- is_list_of_suites(List) -> lists:all(fun(Suite) -> @@ -416,29 +583,29 @@ is_list_of_suites(List) -> %% Create a spec to skip all SUITES, this is used when the application %% to be tested is not part of the OTP release to be tested. -create_skip_spec(Testspec, SuitesToSkip) -> +create_skip_spec(App, SuitesToSkip) -> {ok,Cwd} = file:get_cwd(), - TestspecString = atom_to_list(Testspec), - Specname = TestspecString++"_skip.spec", + AppString = atom_to_list(App), + Specname = AppString++"_skip.spec", {ok,D} = file:open(filename:join([filename:dirname(Cwd), - TestspecString++"_test",Specname]), + AppString++"_test",Specname]), [write]), - TestDir = "\"../"++TestspecString++"_test\"", + TestDir = "\"../"++AppString++"_test\"", io:format(D,"{suites, "++TestDir++", all}.~n",[]), io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application" " is not in path!\"}.",[SuitesToSkip]), Specname. -%% Check testspec to be valid and get possible Options -%% from the config. -check_test_get_opts(Testspec, Config) -> - validate_test(Testspec), - Mode = configmember(batch, {batch, interactive}, Config), - Vars = configvars(Config), - Trace = get_config(trace,Config), - ConfigPath = get_config(config,Config), - KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Config), - Cover = configcover(Testspec,Config), +%% Check testspec for App to be valid and get possible options +%% from the list. +check_test_get_opts(App, Opts) -> + validate_test(App), + Mode = configmember(batch, {batch, interactive}, Opts), + Vars = configvars(Opts), + Trace = get_config(trace,Opts), + ConfigPath = get_config(config,Opts), + KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Opts), + Cover = configcover(App,Opts), lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). to_erlang_term(Atom) -> @@ -447,7 +614,7 @@ to_erlang_term(Atom) -> {ok, Term} = erl_parse:parse_term(Tokens), Term. -%% Validate that a Testspec really is a testspec, +%% Validate that Testspec really is a testspec, %% and exit if not. validate_test(Testspec) -> case lists:member(Testspec, tests()) of @@ -460,10 +627,10 @@ validate_test(Testspec) -> exit(self(), {error, test_not_available}) end. -configvars(Config) -> - case lists:keysearch(vars, 1, Config) of +configvars(Opts) -> + case lists:keysearch(vars, 1, Opts) of {value, {vars, List}} -> - List0 = special_vars(Config), + List0 = special_vars(Opts), Key = fun(T) -> element(1,T) end, DelDupList = lists:filter(fun(V) -> @@ -474,17 +641,17 @@ configvars(Config) -> end, List), {vars, [List0|DelDupList]}; _ -> - {vars, special_vars(Config)} + {vars, special_vars(Opts)} end. -%% Allow some shortcuts in the Options... -special_vars(Config) -> +%% Allow some shortcuts in the options... +special_vars(Opts) -> SpecVars = - case lists:member(verbose, Config) of + case lists:member(verbose, Opts) of true -> [{verbose, 1}]; false -> - case lists:keysearch(verbose, 1, Config) of + case lists:keysearch(verbose, 1, Opts) of {value, {verbose, Lvl}} -> [{verbose, Lvl}]; _ -> @@ -492,13 +659,13 @@ special_vars(Config) -> end end, SpecVars1 = - case lists:keysearch(diskless, 1, Config) of + case lists:keysearch(diskless, 1, Opts) of {value,{diskless, true}} -> [{diskless, true} | SpecVars]; _ -> SpecVars end, - case lists:keysearch(testcase_callback, 1, Config) of + case lists:keysearch(testcase_callback, 1, Opts) of {value,{testcase_callback, CBM, CBF}} -> [{ts_testcase_callback, {CBM,CBF}} | SpecVars1]; {value,{testcase_callback, CB}} -> @@ -566,50 +733,31 @@ check_for_cross_cover_analysis_flag([_|Config],Level,CrossFlag) -> check_for_cross_cover_analysis_flag([],_,_) -> false. -%% Returns a list of available test suites. +%% Returns all available apps. tests() -> {ok, Cwd} = file:get_cwd(), ts_lib:specs(Cwd). -tests(Spec) -> +%% Returns all apps that provide tests in the given test category +tests(main) -> {ok, Cwd} = file:get_cwd(), - ts_lib:suites(Cwd, atom_to_list(Spec)). - -%% Benchmark related functions - -bench() -> - bench([]). - -bench(Opts) when is_list(Opts) -> - bench(benchmarks(),Opts); -bench(Spec) -> - bench([Spec],[]). - -bench(Spec, Opts) when is_atom(Spec) -> - bench([Spec],Opts); -bench(Specs, Opts) -> - check_and_run(fun(Vars) -> ts_benchmark:run(Specs, Opts, Vars) end). - -benchmarks() -> - ts_benchmark:benchmarks(). - -smoke_test() -> - smoke_test([]). - -smoke_test(Opts) when is_list(Opts) -> - smoke_test(smoke_tests(),Opts); -smoke_test(Spec) -> - smoke_test([Spec],[]). - -smoke_test(Spec, Opts) when is_atom(Spec) -> - smoke_test([Spec],Opts); -smoke_test(Specs, Opts) -> - run(Specs, [{smoke,true}|Opts]). + ts_lib:specs(Cwd); +tests(bench) -> + ts_benchmark:benchmarks(); +tests(TestCategory) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specialized_specs(Cwd, atom_to_list(TestCategory)). + +%% Returns a list of available test suites for App. +suites(App) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:suites(Cwd, atom_to_list(App)). -smoke_tests() -> +%% Returns all available test categories for App +categories(App) -> {ok, Cwd} = file:get_cwd(), - ts_lib:specialized_specs(Cwd,"smoke"). + ts_lib:test_categories(Cwd, atom_to_list(App)). %% %% estone/0, estone/1 diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 3dfa6174fe..54ca69637e 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -238,9 +238,15 @@ generate_nodenames2(0, _Hosts, Acc) -> Acc; generate_nodenames2(N, Hosts, Acc) -> Host=lists:nth((N rem (length(Hosts)))+1, Hosts), - Name=list_to_atom(temp_nodename("nod") ++ "@" ++ Host), + Name=list_to_atom(temp_nodename("nod",N) ++ "@" ++ Host), generate_nodenames2(N-1, Hosts, [Name|Acc]). -temp_nodename(Base) -> - Num = erlang:unique_integer([positive]), - Base ++ integer_to_list(Num). +%% We cannot use erlang:unique_integer([positive]) +%% here since this code in run on older test releases as well. +temp_nodename(Base,I) -> + {A,B,C} = os:timestamp(), + Nstr = integer_to_list(I), + Astr = integer_to_list(A), + Bstr = integer_to_list(B), + Cstr = integer_to_list(C), + Base++Nstr++Astr++Bstr++Cstr. diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 5368960446..d27bc55b3a 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -27,7 +27,7 @@ erlang_type/1, initial_capital/1, specs/1, suites/2, - specialized_specs/2, + test_categories/2, specialized_specs/2, subst_file/3, subst/2, print_data/1, make_non_erlang/2, maybe_atom_to_list/1, progress/4, @@ -96,26 +96,47 @@ specialized_specs(Dir,PostFix) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), "*_test", "*_"++PostFix++".spec"])), sort_tests([begin - Base = filename:basename(Name), - list_to_atom(string:substr(Base,1,string:rstr(Base,"_")-1)) + DirPart = filename:dirname(Name), + AppTest = hd(lists:reverse(filename:split(DirPart))), + list_to_atom(string:substr(AppTest, 1, length(AppTest)-5)) end || Name <- Specs]). specs(Dir) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), "*_test", "*.{dyn,}spec"])), - % Filter away all spec which end with {_bench,_smoke}.spec - NoBench = fun(SpecName) -> - case lists:reverse(SpecName) of - "ceps.hcneb_"++_ -> false; - "ceps.ekoms_"++_ -> false; - _ -> true - end - end, - - sort_tests([filename_to_atom(Name) || Name <- Specs, NoBench(Name)]). - -suites(Dir, Spec) -> - Glob=filename:join([filename:dirname(Dir), Spec++"_test", + %% Make sure only to include the main spec for each application + MainSpecs = + lists:flatmap(fun(FullName) -> + [Spec,TestDir|_] = + lists:reverse(filename:split(FullName)), + [_TestSuffix|TDParts] = + lists:reverse(string:tokens(TestDir,[$_,$.])), + [_SpecSuffix|SParts] = + lists:reverse(string:tokens(Spec,[$_,$.])), + if TDParts == SParts -> + [filename_to_atom(FullName)]; + true -> + [] + end + end, Specs), + sort_tests(MainSpecs). + +test_categories(Dir, App) -> + Specs = filelib:wildcard(filename:join([filename:dirname(Dir), + App++"_test", "*.spec"])), + lists:flatmap(fun(FullName) -> + [Spec,_TestDir|_] = + lists:reverse(filename:split(FullName)), + case filename:rootname(Spec -- App) of + "" -> + []; + [_Sep | Cat] -> + [list_to_atom(Cat)] + end + end, Specs). + +suites(Dir, App) -> + Glob=filename:join([filename:dirname(Dir), App++"_test", "*_SUITE.erl"]), Suites=filelib:wildcard(Glob), [filename_to_atom(Name) || Name <- Suites]. diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index 77225b4cad..2a2ed2b3b0 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.8 +TEST_SERVER_VSN = 3.8.1 diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 6c32c47069..71e17e0ba1 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -136,7 +136,7 @@ -define(SERVER, cover_server). %% Line doesn't matter. --define(BLOCK(Expr), {block,0,[Expr]}). +-define(BLOCK(Expr), {block,erl_anno:new(0),[Expr]}). -define(BLOCK1(Expr), if element(1, Expr) =:= block -> @@ -1626,18 +1626,18 @@ expand({clause,Line,Pattern,Guards,Body}, Vs, N) -> expand({op,_Line,'andalso',ExprL,ExprR}, Vs, N) -> {ExpandedExprL,N2} = expand(ExprL, Vs, N), {ExpandedExprR,N3} = expand(ExprR, Vs, N2), - LineL = element(2, ExpandedExprL), + Anno = element(2, ExpandedExprL), {bool_switch(ExpandedExprL, ExpandedExprR, - {atom,LineL,false}, + {atom,Anno,false}, Vs, N3), N3 + 1}; expand({op,_Line,'orelse',ExprL,ExprR}, Vs, N) -> {ExpandedExprL,N2} = expand(ExprL, Vs, N), {ExpandedExprR,N3} = expand(ExprR, Vs, N2), - LineL = element(2, ExpandedExprL), + Anno = element(2, ExpandedExprL), {bool_switch(ExpandedExprL, - {atom,LineL,true}, + {atom,Anno,true}, ExpandedExprR, Vs, N3), N3 + 1}; @@ -1746,7 +1746,7 @@ munge_body(Expr, Vars) -> munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) -> %% Here is the place to add a call to cover:bump/6! - Line = element(2, Expr), + Line = erl_anno:line(element(2, Expr)), Lines = Vars#vars.lines, case lists:member(Line,Lines) of true -> % already a bump at this line @@ -1882,17 +1882,18 @@ fix_cls([Cl | Cls], Line, Bump) -> false -> {clause,CL,P,G,Body} = Cl, UniqueVarName = list_to_atom(lists:concat(["$cover$ ",Line])), - V = {var,0,UniqueVarName}, + A = erl_anno:new(0), + V = {var,A,UniqueVarName}, [Last|Rest] = lists:reverse(Body), - Body1 = lists:reverse(Rest, [{match,0,V,Last},Bump,V]), + Body1 = lists:reverse(Rest, [{match,A,V,Last},Bump,V]), [{clause,CL,P,G,Body1} | fix_cls(Cls, Line, Bump)] end. bumps_line(E, L) -> try bumps_line1(E, L) catch true -> true end. -bumps_line1({call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, - [{atom,0,?COVER_TABLE},{tuple,0,[_,_,_,_,_,{integer,0,Line}]},_]}, +bumps_line1({call,_,{remote,_,{atom,_,ets},{atom,_,update_counter}}, + [{atom,_,?COVER_TABLE},{tuple,_,[_,_,_,_,_,{integer,_,Line}]},_]}, Line) -> throw(true); bumps_line1([E | Es], Line) -> @@ -1906,15 +1907,16 @@ bumps_line1(_, _) -> %%% End of fix of last expression. bump_call(Vars, Line) -> - {call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, - [{atom,0,?COVER_TABLE}, - {tuple,0,[{atom,0,?BUMP_REC_NAME}, - {atom,0,Vars#vars.module}, - {atom,0,Vars#vars.function}, - {integer,0,Vars#vars.arity}, - {integer,0,Vars#vars.clause}, - {integer,0,Line}]}, - {integer,0,1}]}. + A = erl_anno:new(0), + {call,A,{remote,A,{atom,A,ets},{atom,A,update_counter}}, + [{atom,A,?COVER_TABLE}, + {tuple,A,[{atom,A,?BUMP_REC_NAME}, + {atom,A,Vars#vars.module}, + {atom,A,Vars#vars.function}, + {integer,A,Vars#vars.arity}, + {integer,A,Vars#vars.clause}, + {integer,A,Line}]}, + {integer,A,1}]}. munge_expr({match,Line,ExprL,ExprR}, Vars) -> {MungedExprL, Vars2} = munge_expr(ExprL, Vars), diff --git a/lib/tools/src/xref.hrl b/lib/tools/src/xref.hrl index fa8c5c746d..5e79c477f3 100644 --- a/lib/tools/src/xref.hrl +++ b/lib/tools/src/xref.hrl @@ -1,7 +1,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 @@ -22,6 +22,8 @@ -define(VAR_EXPR, '$F_EXPR'). -define(MOD_EXPR, '$M_EXPR'). +-define(XREF_END_LINE, (1 bsl 23)). + %%% Filenames are stored as directory and basename. A lot of heap can %%% be saved by keeping only one (or few) copy of the directory name. diff --git a/lib/tools/src/xref_compiler.erl b/lib/tools/src/xref_compiler.erl index c4b5c04c12..c914a76bf0 100644 --- a/lib/tools/src/xref_compiler.erl +++ b/lib/tools/src/xref_compiler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. 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 @@ -924,7 +924,7 @@ format_parse_error(["invalid_operator", Op], Line) -> format_parse_error(Error, Line) -> io_lib:format("Parse error~s: ~ts~n", [Line, lists:flatten(Error)]). -format_line(-1) -> +format_line(?XREF_END_LINE) -> " at end of string"; format_line(0) -> ""; diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index 142d28ebe6..723fb729cd 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. 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 @@ -77,17 +77,18 @@ forms([], S) -> form({attribute, Line, xref, Calls}, S) -> % experimental #xrefr{module = M, function = Fun, lattrs = L, xattrs = X, battrs = B} = S, - attr(Calls, Line, M, Fun, L, X, B, S); + attr(Calls, erl_anno:line(Line), M, Fun, L, X, B, S); form({attribute, _Line, _Attr, _Val}, S) -> S; -form({function, 0, module_info, 0, _Clauses}, S) -> +form({function, _, module_info, 0, _Clauses}, S) -> S; -form({function, 0, module_info, 1, _Clauses}, S) -> +form({function, _, module_info, 1, _Clauses}, S) -> S; -form({function, Line, Name, Arity, Clauses}, S) -> +form({function, Anno, Name, Arity, Clauses}, S) -> MFA0 = {S#xrefr.module, Name, Arity}, MFA = adjust_arity(S, MFA0), S1 = S#xrefr{function = MFA}, + Line = erl_anno:line(Anno), S2 = S1#xrefr{def_at = [{MFA,Line} | S#xrefr.def_at]}, S3 = clauses(Clauses, S2), S3#xrefr{function = []}. @@ -305,10 +306,14 @@ fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; fun_args(1, [FunArg | Args]) -> {FunArg, Args}; fun_args(2, [_Node, FunArg | Args]) -> {FunArg, Args}. -list2term([A | As]) -> - {cons, 0, A, list2term(As)}; -list2term([]) -> - {nil, 0}. +list2term(L) -> + A = erl_anno:new(0), + list2term(L, A). + +list2term([A | As], Anno) -> + {cons, Anno, A, list2term(As)}; +list2term([], Anno) -> + {nil, Anno}. term2list({cons, _Line, H, T}, L, S) -> term2list(T, [H | L], S); @@ -335,10 +340,11 @@ handle_call(Locality, Module, Name, Arity, Line, S) -> handle_call(Locality, To, Line, S, false) end. -handle_call(Locality, To0, Line, S, IsUnres) -> +handle_call(Locality, To0, Anno, S, IsUnres) -> From = S#xrefr.function, To = adjust_arity(S, To0), Call = {From, To}, + Line = erl_anno:line(Anno), CallAt = {Call, Line}, S1 = if IsUnres -> diff --git a/lib/tools/src/xref_scanner.erl b/lib/tools/src/xref_scanner.erl index 990f8aa87b..4c93033d7c 100644 --- a/lib/tools/src/xref_scanner.erl +++ b/lib/tools/src/xref_scanner.erl @@ -1,7 +1,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 @@ -19,6 +19,8 @@ -module(xref_scanner). +-include("xref.hrl"). + -export([scan/1]). scan(Chars) -> @@ -77,7 +79,7 @@ lex([V={var,N,Var} | L]) -> lex([T | Ts]) -> [T | lex(Ts)]; lex([]) -> - [{'$end', -1}]. + [{'$end', erl_anno:new(?XREF_END_LINE)}]. is_type('Rel') -> true; is_type('App') -> true; 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/doc/src/Makefile b/lib/webtool/doc/src/Makefile index 32269e9424..08292fcca8 100644 --- a/lib/webtool/doc/src/Makefile +++ b/lib/webtool/doc/src/Makefile @@ -25,6 +25,10 @@ include ../../vsn.mk VSN=$(WEBTOOL_VSN) APPLICATION=webtool +DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ +The Webtool application is obsolete and will be removed \ +in the next major OTP release + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 720526b3b9..8e32aeddc8 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -197,8 +197,8 @@ gen_funcs(Defs) -> w(" if(recurse_level > 1 && refd->type != 4) {~n"), w(" delayed_delete->Append(Ecmd.Save());~n"), w(" } else {~n"), - w(" ((WxeApp *) wxTheApp)->clearPtr(This);~n"), - w(" delete_object(This, refd); }~n"), + w(" delete_object(This, refd);~n"), + w(" ((WxeApp *) wxTheApp)->clearPtr(This);}~n"), w(" } } break;~n"), w(" case WXE_REGISTER_OBJECT: {~n" " registerPid(bp, Ecmd.caller, memenv);~n" diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf index 09f21af0f3..bbf9add59e 100644 --- a/lib/wx/api_gen/wxapi.conf +++ b/lib/wx/api_gen/wxapi.conf @@ -1358,7 +1358,8 @@ wxEVT_SCROLL_THUMBRELEASE,wxEVT_SCROLL_CHANGED]}], ['GetOrientation','GetPosition']}. {class, wxScrollWinEvent,wxEvent, - [{event, + [{acc, [{m_commandInt, "GetPosition()"}, {m_extraLong, "GetOrientation()"}]}, + {event, [wxEVT_SCROLLWIN_TOP,wxEVT_SCROLLWIN_BOTTOM,wxEVT_SCROLLWIN_LINEUP, wxEVT_SCROLLWIN_LINEDOWN,wxEVT_SCROLLWIN_PAGEUP, wxEVT_SCROLLWIN_PAGEDOWN,wxEVT_SCROLLWIN_THUMBTRACK, @@ -1383,7 +1384,9 @@ 'ShiftDown' ]}. -{class, wxSetCursorEvent, wxEvent, [{event,[wxEVT_SET_CURSOR]}], +{class, wxSetCursorEvent, wxEvent, + [{acc, [{m_x, "GetX()"}, {m_y, "GetY()"}, {m_cursor, "GetCursor()"}]}, + {event,[wxEVT_SET_CURSOR]}], ['GetCursor','GetX','GetY','HasCursor','SetCursor']}. {class, wxKeyEvent, wxEvent, @@ -1398,7 +1401,7 @@ {class, wxSizeEvent, wxEvent, [{event,[wxEVT_SIZE]}], ['GetSize']}. -{class, wxMoveEvent, wxEvent, [{event,[wxEVT_MOVE]}], +{class, wxMoveEvent, wxEvent, [{acc, [{m_pos, "GetPosition()"}, {m_rect, "GetRect()"}]}, {event,[wxEVT_MOVE]}], ['GetPosition']}. {class, wxPaintEvent, wxEvent, [{event,[wxEVT_PAINT]}],[]}. %%{class, wxNcPaintEvent, wxEvent, [{event,[wxEVT_NC_PAINT]}],[]}. @@ -1407,28 +1410,28 @@ {event, [wxEVT_ERASE_BACKGROUND]}], ['GetDC']}. {class, wxFocusEvent, wxEvent, - [{event,[wxEVT_SET_FOCUS,wxEVT_KILL_FOCUS]}], + [{acc, [{m_win, "GetWindow()"}]}, + {event,[wxEVT_SET_FOCUS,wxEVT_KILL_FOCUS]}], ['GetWindow']}. {class,wxChildFocusEvent,wxCommandEvent, [{event,[wxEVT_CHILD_FOCUS]}], ['GetWindow']}. -%% {class, wxActivateEvent, wxEvent, [{event, -%% [wxEVT_ACTIVATE,wxEVT_ACTIVATE_APP,wxEVT_HIBERNATE]}],[]}. - -%%{class, wxInitDialogEvent, wxEvent, [{event, []}],[]}. - -{class, wxMenuEvent, wxEvent, - [{event, [wxEVT_MENU_OPEN,wxEVT_MENU_CLOSE,wxEVT_MENU_HIGHLIGHT]}], +{class, wxMenuEvent, wxEvent, + [{acc, [{m_menuId, "GetMenuId()"}, {m_menu, "GetMenu()"}]}, + {event, [wxEVT_MENU_OPEN,wxEVT_MENU_CLOSE,wxEVT_MENU_HIGHLIGHT]}], ['GetMenu','GetMenuId','IsPopup']}. {class, wxCloseEvent, wxEvent, [{event, [wxEVT_CLOSE_WINDOW,wxEVT_END_SESSION,wxEVT_QUERY_END_SESSION]}], ['CanVeto','GetLoggingOff','SetCanVeto','SetLoggingOff','Veto']}. -{class, wxShowEvent, wxEvent, [{event,[wxEVT_SHOW]}],['SetShow','GetShow']}. -{class, wxIconizeEvent, wxEvent, [{event,[wxEVT_ICONIZE]}],['Iconized']}. +{class, wxShowEvent, wxEvent, [{acc, [{m_show, "GetShow()"}]},{event,[wxEVT_SHOW]}],['SetShow','GetShow']}. +{class, wxIconizeEvent, wxEvent, [{acc, [{m_iconized, "Iconized()"}]},{event,[wxEVT_ICONIZE]}],['Iconized']}. {class, wxMaximizeEvent, wxEvent, [{event,[wxEVT_MAXIMIZE]}],[]}. -{class, wxJoystickEvent, wxEvent, - [{event,[wxEVT_JOY_BUTTON_DOWN,wxEVT_JOY_BUTTON_UP, +{class, wxJoystickEvent, wxEvent, + [{acc, [{m_pos, "GetPosition()"},{m_zPosition, "GetZPosition()"}, + {m_buttonChange, "GetButtonChange()"}, {m_buttonState, "GetButtonState()"}, + {m_joyStick, "GetJoystick()"}]}, + {event,[wxEVT_JOY_BUTTON_DOWN,wxEVT_JOY_BUTTON_UP, wxEVT_JOY_MOVE,wxEVT_JOY_ZMOVE]}], ['ButtonDown','ButtonIsDown','ButtonUp','GetButtonChange','GetButtonState', 'GetJoystick','GetPosition','GetZPosition','IsButton','IsMove','IsZMove']}. @@ -1466,7 +1469,8 @@ 'SetOrigin', 'SetPosition']}. -{class, wxContextMenuEvent, wxCommandEvent, [{event,[wxEVT_CONTEXT_MENU]}], +{class, wxContextMenuEvent, wxCommandEvent, + [{acc, [{m_pos, "GetPosition()"}]}, {event,[wxEVT_CONTEXT_MENU]}], ['GetPosition','SetPosition']}. {enum, wxIdleMode, "wxIDLE_"}. {class, wxIdleEvent, wxEvent, [{event,[wxEVT_IDLE]}], @@ -1525,7 +1529,8 @@ ]}. {class, wxCalendarEvent, wxDateEvent, - [{event,[wxEVT_CALENDAR_SEL_CHANGED, wxEVT_CALENDAR_DAY_CHANGED, + [{acc, [{m_date, "GetDate()"}, {m_wday, "GetWeekDay()"}]}, + {event,[wxEVT_CALENDAR_SEL_CHANGED, wxEVT_CALENDAR_DAY_CHANGED, wxEVT_CALENDAR_MONTH_CHANGED, wxEVT_CALENDAR_YEAR_CHANGED, wxEVT_CALENDAR_DOUBLECLICKED, wxEVT_CALENDAR_WEEKDAY_CLICKED]}], [ @@ -1730,8 +1735,9 @@ ['GetKeyCode','GetItem','GetKeyEvent','GetLabel','GetOldItem','GetPoint', 'IsEditCancelled','SetToolTip']}. -{class, wxNotebookEvent, wxNotifyEvent, - [{event, [wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED, +{class, wxNotebookEvent, wxNotifyEvent, + [{acc, [{m_nSel, "GetSelection()"}, {m_nOldSel, "GetOldSelection()"}]}, + {event, [wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED, wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGING]}], ['GetOldSelection','GetSelection','SetOldSelection','SetSelection']}. diff --git a/lib/wx/c_src/gen/wxe_events.cpp b/lib/wx/c_src/gen/wxe_events.cpp index ae85931d8d..e042b4d890 100644 --- a/lib/wx/c_src/gen/wxe_events.cpp +++ b/lib/wx/c_src/gen/wxe_events.cpp @@ -375,10 +375,13 @@ case 165: {// wxScrollEvent or wxSpinEvent break; } case 166: {// wxScrollWinEvent + wxScrollWinEvent * ev = (wxScrollWinEvent *) event; evClass = (char*)"wxScrollWinEvent"; rt.addAtom((char*)"wxScrollWin"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetPosition()); + rt.addInt(ev->GetOrientation()); + rt.addTupleCount(4); break; } case 167: {// wxMouseEvent @@ -406,10 +409,16 @@ case 167: {// wxMouseEvent break; } case 168: {// wxSetCursorEvent + wxSetCursorEvent * ev = (wxSetCursorEvent *) event; + wxCursor * GetCursor = new wxCursor(ev->GetCursor()); + app->newPtr((void *) GetCursor,3, memenv); evClass = (char*)"wxSetCursorEvent"; rt.addAtom((char*)"wxSetCursor"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetX()); + rt.addInt(ev->GetY()); + rt.addRef(getRef((void *)GetCursor,memenv), "wxCursor"); + rt.addTupleCount(5); break; } case 169: {// wxKeyEvent @@ -450,10 +459,13 @@ case 170: {// wxSizeEvent break; } case 171: {// wxMoveEvent + wxMoveEvent * ev = (wxMoveEvent *) event; evClass = (char*)"wxMoveEvent"; rt.addAtom((char*)"wxMove"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.add(ev->GetRect()); + rt.addTupleCount(4); break; } case 172: {// wxPaintEvent @@ -474,10 +486,13 @@ case 173: {// wxEraseEvent break; } case 174: {// wxFocusEvent + wxFocusEvent * ev = (wxFocusEvent *) event; + wxWindow * GetWindow = ev->GetWindow(); evClass = (char*)"wxFocusEvent"; rt.addAtom((char*)"wxFocus"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addRef(getRef((void *)GetWindow,memenv), "wxWindow"); + rt.addTupleCount(3); break; } case 175: {// wxChildFocusEvent @@ -488,10 +503,14 @@ case 175: {// wxChildFocusEvent break; } case 176: {// wxMenuEvent + wxMenuEvent * ev = (wxMenuEvent *) event; + wxMenu * GetMenu = ev->GetMenu(); evClass = (char*)"wxMenuEvent"; rt.addAtom((char*)"wxMenu"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetMenuId()); + rt.addRef(getRef((void *)GetMenu,memenv), "wxMenu"); + rt.addTupleCount(4); break; } case 177: {// wxCloseEvent @@ -502,17 +521,21 @@ case 177: {// wxCloseEvent break; } case 178: {// wxShowEvent + wxShowEvent * ev = (wxShowEvent *) event; evClass = (char*)"wxShowEvent"; rt.addAtom((char*)"wxShow"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addBool(ev->GetShow()); + rt.addTupleCount(3); break; } case 179: {// wxIconizeEvent + wxIconizeEvent * ev = (wxIconizeEvent *) event; evClass = (char*)"wxIconizeEvent"; rt.addAtom((char*)"wxIconize"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addBool(ev->Iconized()); + rt.addTupleCount(3); break; } case 180: {// wxMaximizeEvent @@ -523,10 +546,16 @@ case 180: {// wxMaximizeEvent break; } case 181: {// wxJoystickEvent + wxJoystickEvent * ev = (wxJoystickEvent *) event; evClass = (char*)"wxJoystickEvent"; rt.addAtom((char*)"wxJoystick"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.addInt(ev->GetZPosition()); + rt.addInt(ev->GetButtonChange()); + rt.addInt(ev->GetButtonState()); + rt.addInt(ev->GetJoystick()); + rt.addTupleCount(7); break; } case 182: {// wxUpdateUIEvent @@ -603,10 +632,12 @@ case 191: {// wxHelpEvent break; } case 192: {// wxContextMenuEvent + wxContextMenuEvent * ev = (wxContextMenuEvent *) event; evClass = (char*)"wxContextMenuEvent"; rt.addAtom((char*)"wxContextMenu"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.addTupleCount(3); break; } case 193: {// wxIdleEvent @@ -667,10 +698,13 @@ case 198: {// wxDateEvent break; } case 199: {// wxCalendarEvent + wxCalendarEvent * ev = (wxCalendarEvent *) event; evClass = (char*)"wxCalendarEvent"; rt.addAtom((char*)"wxCalendar"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetWeekDay()); + rt.add(ev->GetDate()); + rt.addTupleCount(4); break; } case 200: {// wxFileDirPickerEvent @@ -742,10 +776,13 @@ case 209: {// wxTreeEvent break; } case 210: {// wxNotebookEvent + wxNotebookEvent * ev = (wxNotebookEvent *) event; evClass = (char*)"wxNotebookEvent"; rt.addAtom((char*)"wxNotebook"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetSelection()); + rt.addInt(ev->GetOldSelection()); + rt.addTupleCount(4); break; } case 216: {// wxClipboardTextEvent diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 91ce5d810c..3b11c0642e 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2014. 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 @@ -51,8 +51,8 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) if(recurse_level > 1 && refd->type != 4) { delayed_delete->Append(Ecmd.Save()); } else { - ((WxeApp *) wxTheApp)->clearPtr(This); - delete_object(This, refd); } + delete_object(This, refd); + ((WxeApp *) wxTheApp)->clearPtr(This);} } } break; case WXE_REGISTER_OBJECT: { registerPid(bp, Ecmd.caller, memenv); diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index a9feb23831..26b45d219e 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -135,8 +135,12 @@ void deleteActiveGL(wxGLCanvas *canvas) void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ if(caller != gl_active) { wxGLCanvas * current = glc[caller]; - if(current) { gl_active = caller; current->SetCurrent();} - else { + if(current) { + if(current != glc[gl_active]) { + gl_active = caller; + current->SetCurrent(); + } + } else { ErlDrvTermData rt[] = // Error msg {ERL_DRV_ATOM, driver_mk_atom((char *) "_egl_error_"), ERL_DRV_INT, (ErlDrvTermData) op, diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 15d75080d9..120919e7aa 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -24,23 +24,96 @@ * Erlang Commands * ****************************************************************************/ -wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) - : wxObject() +wxeCommand::wxeCommand() { +} + +wxeCommand::~wxeCommand() +{ + Delete(); +} + +void wxeCommand::Delete() +{ + int n = 0; + + if(buffer) { + while(bin[n]) { + if(bin[n]->bin) + driver_free_binary(bin[n]->bin); + driver_free(bin[n++]); + } + if(len > 64) + driver_free(buffer); + buffer = NULL; + op = -1; + } +} + +/* **************************************************************************** + * wxeFifo + * ****************************************************************************/ +wxeFifo::wxeFifo(unsigned int sz) +{ + m_q = (wxeCommand *) driver_alloc(sizeof(wxeCommand) * sz); + m_orig_sz = sz; + m_max = sz; + m_n = 0; + m_first = 0; + m_old = NULL; + for(unsigned int i = 0; i < sz; i++) { + m_q[i].buffer = NULL; + m_q[i].op = -1; + } +} + +wxeFifo::~wxeFifo() { + // dealloc all memory buffers + driver_free(m_q); +} + +wxeCommand * wxeFifo::Get() +{ + unsigned int pos; + if(m_n > 0) { + pos = m_first++; + m_n--; + m_first %= m_max; + return &m_q[pos]; + } + return NULL; +} + +void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) +{ + unsigned int pos; + wxeCommand *curr; + WXEBinRef *temp, *start, *prev; int n = 0; - ref_count = 1; - caller = driver_caller(sd->port_handle); - port = sd->port; - op = fc; - len = buflen; - bin[0] = NULL; - bin[1] = NULL; - bin[2] = NULL; + + if(m_n == (m_max-1)) { // resize + Realloc(); + } + + pos = (m_first + m_n) % m_max; + m_n++; + + curr = &m_q[pos]; + curr->caller = driver_caller(sd->port_handle); + curr->port = sd->port; + curr->op = fc; + curr->len = buflen; + curr->bin[0] = NULL; + curr->bin[1] = NULL; + curr->bin[2] = NULL; if(cbuf) { - buffer = (char *) driver_alloc(len); - memcpy((void *) buffer, (void *) cbuf, len);; + if(buflen > 64) + curr->buffer = (char *) driver_alloc(buflen); + else + curr->buffer = curr->c_buf; + memcpy((void *) curr->buffer, (void *) cbuf, buflen); temp = sd->bin; @@ -48,8 +121,8 @@ wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) start = temp; while(temp) { - if(caller == temp->from) { - bin[n++] = temp; + if(curr->caller == temp->from) { + curr->bin[n++] = temp; if(prev) { prev->next = temp->next; } else { @@ -63,20 +136,68 @@ wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) } sd->bin = start; } else { // No-op only PING currently - buffer = NULL; + curr->buffer = NULL; } } -wxeCommand::~wxeCommand() { - int n = 0; - if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); +void wxeFifo::Append(wxeCommand *orig) +{ + unsigned int pos; + wxeCommand *curr; + if(m_n == (m_max-1)) { // resize + Realloc(); + } + + pos = (m_first + m_n) % m_max; + m_n++; + curr = &m_q[pos]; + curr->caller = orig->caller; + curr->port = orig->port; + curr->op = orig->op; + curr->len = orig->len; + curr->bin[0] = orig->bin[0]; + curr->bin[1] = orig->bin[1]; + curr->bin[2] = orig->bin[2]; + + if(orig->len > 64) + curr->buffer = orig->buffer; + else { + curr->buffer = curr->c_buf; + memcpy((void *) curr->buffer, (void *) orig->buffer, orig->len); + } + orig->op = -1; + orig->buffer = NULL; + orig->bin[0] = NULL; +} + +void wxeFifo::Realloc() +{ + unsigned int i; + unsigned int growth = m_orig_sz / 2; + unsigned int new_sz = growth + m_max; + unsigned int max = m_max; + unsigned int first = m_first; + unsigned int n = m_n; + wxeCommand * old = m_q; + wxeCommand * queue = (wxeCommand *)driver_alloc(new_sz*sizeof(wxeCommand)); + + m_max=new_sz; + m_first = 0; + m_n=0; + m_q = queue; + + for(i=0; i < n; i++) { + unsigned int pos = i+first; + if(old[pos%max].op >= 0) { + Append(&old[pos%max]); } - driver_free(buffer); } + for(i = m_n; i < new_sz; i++) { // Reset the rest + m_q[i].buffer = NULL; + m_q[i].op = -1; + } + // Can not free old queue here it can be used in the wx thread + m_old = old; } /* **************************************************************************** diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index 659bc666c6..ec3a5debdb 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -39,14 +39,14 @@ class wxeMetaCommand : public wxEvent ErlDrvPDL pdl; }; -class wxeCommand : public wxObject +class wxeCommand { public: - wxeCommand(int fc,char * cbuf,int buflen, wxe_data *); + wxeCommand(); virtual ~wxeCommand(); // Use Delete() - wxeCommand * Save() {ref_count++; return this; }; - void Delete() {if(--ref_count < 1) delete this;}; + wxeCommand * Save() { return this; }; + void Delete(); ErlDrvTermData caller; ErlDrvTermData port; @@ -54,7 +54,27 @@ class wxeCommand : public wxObject char * buffer; int len; int op; - int ref_count; + char c_buf[64]; // 64b covers 90% of usage +}; + +class wxeFifo { + public: + wxeFifo(unsigned int size); + virtual ~wxeFifo(); + + void Add(int fc, char * cbuf,int buflen, wxe_data *); + void Append(wxeCommand *Other); + + wxeCommand * Get(); + + void Realloc(); + + unsigned int m_max; + unsigned int m_first; + unsigned int m_n; + unsigned int m_orig_sz; + wxeCommand *m_q; + wxeCommand *m_old; }; class intListElement { diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 0ee52e3af2..ef648e008c 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -55,8 +55,9 @@ extern ErlDrvCond * wxe_batch_locker_c; extern ErlDrvTermData init_caller; extern int wxe_status; -wxList * wxe_batch = NULL; -wxList * wxe_batch_cb_saved = NULL; +wxeFifo * wxe_queue = NULL; +wxeFifo * wxe_queue_cb_saved = NULL; + int wxe_batch_caller = 0; // inside batch if larger than 0 /* ************************************************************ @@ -68,30 +69,30 @@ void push_command(int op,char * buf,int len, wxe_data *sd) { /* fprintf(stderr, "Op %d %d [%ld] %d\r\n", op, (int) driver_caller(sd->port_handle), wxe_batch->size(), wxe_batch_caller),fflush(stderr); */ - wxeCommand *Cmd = new wxeCommand(op, buf, len, sd); erl_drv_mutex_lock(wxe_batch_locker_m); - wxe_batch->Append(Cmd); + wxe_queue->Add(op, buf, len, sd); if(wxe_batch_caller > 0) { // wx-thread is waiting on batch end in cond_wait erl_drv_cond_signal(wxe_batch_locker_c); + erl_drv_mutex_unlock(wxe_batch_locker_m); } else { // wx-thread is waiting gui-events if(op == WXE_BATCH_BEGIN) { wxe_batch_caller = 1; } erl_drv_cond_signal(wxe_batch_locker_c); + erl_drv_mutex_unlock(wxe_batch_locker_m); wxWakeUpIdle(); } - erl_drv_mutex_unlock(wxe_batch_locker_m); + } void meta_command(int what, wxe_data *sd) { if(what == PING_PORT) { erl_drv_mutex_lock(wxe_batch_locker_m); if(wxe_batch_caller > 0) { - wxeCommand *Cmd = new wxeCommand(WXE_DEBUG_PING, NULL, 0, sd); - wxe_batch->Append(Cmd); + wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd); erl_drv_cond_signal(wxe_batch_locker_c); } wxWakeUpIdle(); @@ -121,12 +122,12 @@ bool WxeApp::OnInit() { global_me = new wxeMemEnv(); - wxe_batch = new wxList; - wxe_batch_cb_saved = new wxList; + wxe_queue = new wxeFifo(1000); + wxe_queue_cb_saved = new wxeFifo(200); cb_buff = NULL; recurse_level = 0; - delayed_cleanup = new wxList; - delayed_delete = new wxList; + delayed_delete = new wxeFifo(10); + delayed_cleanup = new wxList; wxe_ps_init2(); // wxIdleEvent::SetMode(wxIDLE_PROCESS_SPECIFIED); // Hmm printpreview doesn't work in 2.9 with this @@ -169,6 +170,8 @@ void WxeApp::MacOpenFile(const wxString &filename) { void WxeApp::shutdown(wxeMetaCommand& Ecmd) { ExitMainLoop(); + delete wxe_queue; + delete wxe_queue_cb_saved; } void WxeApp::dummy_close(wxEvent& Ev) { @@ -201,11 +204,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) if(driver_monitor_process(port, process, &monitor) == 0) { // Should we be able to handle commands when recursing? probably erl_drv_mutex_lock(wxe_batch_locker_m); - //fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); + // fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); app->recurse_level++; - app->dispatch_cb(wxe_batch, wxe_batch_cb_saved, process); + app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process); app->recurse_level--; - //fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); + // fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); wxe_batch_caller = 0; erl_drv_mutex_unlock(wxe_batch_locker_m); driver_demonitor_process(port, &monitor); @@ -216,22 +219,22 @@ void WxeApp::dispatch_cmds() { erl_drv_mutex_lock(wxe_batch_locker_m); recurse_level++; - int level = dispatch(wxe_batch_cb_saved, 0, WXE_STORED); - dispatch(wxe_batch, level, WXE_NORMAL); + int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED); + dispatch(wxe_queue, level, WXE_NORMAL); recurse_level--; wxe_batch_caller = 0; + if(wxe_queue->m_old) { + driver_free(wxe_queue->m_old); + wxe_queue->m_old = NULL; + } erl_drv_mutex_unlock(wxe_batch_locker_m); // Cleanup old memenv's and deleted objects if(recurse_level == 0) { - if(delayed_delete->size() > 0) - for( wxList::compatibility_iterator node = delayed_delete->GetFirst(); - node; - node = delayed_delete->GetFirst()) { - wxeCommand *event = (wxeCommand *)node->GetData(); - delayed_delete->Erase(node); - wxe_dispatch(*event); - event->Delete(); - } + wxeCommand *curr; + while((curr = delayed_delete->Get()) != NULL) { + wxe_dispatch(*curr); + curr->Delete(); + } if(delayed_cleanup->size() > 0) for( wxList::compatibility_iterator node = delayed_cleanup->GetFirst(); node; @@ -241,158 +244,145 @@ void WxeApp::dispatch_cmds() destroyMemEnv(*event); delete event; } + if(wxe_queue_cb_saved->m_old) { + driver_free(wxe_queue_cb_saved->m_old); + wxe_queue_cb_saved->m_old = NULL; + } + if(delayed_delete->m_old) { + driver_free(delayed_delete->m_old); + delayed_delete->m_old = NULL; + } } } // Should have erl_drv_mutex_lock(wxe_batch_locker_m); // when entering this function and it should be released // afterwards -int WxeApp::dispatch(wxList * batch, int blevel, int list_type) +int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) { int ping = 0; // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already - while(true) - { - if (batch->size() > 0) { - for( wxList::compatibility_iterator node = batch->GetFirst(); - node; - node = batch->GetFirst()) - { - wxeCommand *event = (wxeCommand *)node->GetData(); - batch->Erase(node); - switch(event->op) { - case WXE_BATCH_END: - {--blevel; } - break; - case WXE_BATCH_BEGIN: - {blevel++; } - break; - case WXE_DEBUG_PING: - // When in debugger we don't want to hang waiting for a BATCH_END - // that never comes, because a breakpoint have hit. - ping++; - if(ping > 2) - blevel = 0; - break; - case WXE_CB_RETURN: - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary - if(event->len > 0) { - cb_buff = (char *) driver_alloc(event->len); - memcpy(cb_buff, event->buffer, event->len); - } - return blevel; - default: - erl_drv_mutex_unlock(wxe_batch_locker_m); - if(event->op < OPENGL_START) { - // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); - wxe_dispatch(*event); - } else { - gl_dispatch(event->op,event->buffer,event->caller,event->bin); - } - erl_drv_mutex_lock(wxe_batch_locker_m); - break; - } - event->Delete(); - } - } else { - if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary - return blevel; + wxeCommand *event; + while(true) { + while((event = batch->Get()) != NULL) { + switch(event->op) { + case -1: + break; + case WXE_BATCH_END: + {--blevel; } + break; + case WXE_BATCH_BEGIN: + {blevel++; } + break; + case WXE_DEBUG_PING: + // When in debugger we don't want to hang waiting for a BATCH_END + // that never comes, because a breakpoint have hit. + ping++; + if(ping > 2) + blevel = 0; + break; + case WXE_CB_RETURN: + // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after + // whatever cleaning is necessary + if(event->len > 0) { + cb_buff = (char *) driver_alloc(event->len); + memcpy(cb_buff, event->buffer, event->len); } - // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d %d %d \r\n", __FILE__, __LINE__, batch->size(), callback_returned, blevel, is_callback);fflush(stderr); - wxe_batch_caller++; - while(batch->size() == 0) { - erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + event->Delete(); + return blevel; + default: + erl_drv_mutex_unlock(wxe_batch_locker_m); + if(event->op < OPENGL_START) { + // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); + wxe_dispatch(*event); + } else { + gl_dispatch(event->op,event->buffer,event->caller,event->bin); } + erl_drv_mutex_lock(wxe_batch_locker_m); + break; } + event->Delete(); + } + if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { + // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after + // whatever cleaning is necessary + return blevel; } + // sleep until something happens + //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr); + wxe_batch_caller++; + while(batch->m_n == 0) { + erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + } + } } -void WxeApp::dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process) { - int callback_returned = 0; +void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) { + wxeCommand *event; while(true) { - if (batch->size() > 0) { - for( wxList::compatibility_iterator node = batch->GetFirst(); - node; - node = batch->GetFirst()) - { - wxeCommand *event = (wxeCommand *)node->GetData(); - wxeMemEnv *memenv = getMemEnv(event->port); - batch->Erase(node); - // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); - if(event->caller == process || // Callbacks from CB process only - event->op == WXE_CB_START || // Event callback start change process - event->op == WXE_CB_DIED || // Event callback process died - // Allow connect_cb during CB i.e. msg from wxe_server. - (memenv && event->caller == memenv->owner)) - { - switch(event->op) { - case WXE_BATCH_END: - case WXE_BATCH_BEGIN: - case WXE_DEBUG_PING: - break; - case WXE_CB_RETURN: - if(event->len > 0) { - cb_buff = (char *) driver_alloc(event->len); - memcpy(cb_buff, event->buffer, event->len); - } // continue - case WXE_CB_DIED: - callback_returned = 1; - return; - case WXE_CB_START: - // CB start from now accept message from CB process only - process = event->caller; - break; - default: - erl_drv_mutex_unlock(wxe_batch_locker_m); - size_t start=temp->GetCount(); - if(event->op < OPENGL_START) { - // fprintf(stderr, " cb %d \r\n", event->op); - wxe_dispatch(*event); - } else { - gl_dispatch(event->op,event->buffer,event->caller,event->bin); - } - erl_drv_mutex_lock(wxe_batch_locker_m); - if(temp->GetCount() > start) { - // We have recursed dispatch_cb and messages for this - // callback may be saved on temp list move them - // to orig list - for(wxList::compatibility_iterator node = temp->Item(start); - node; - node = node->GetNext()) { - wxeCommand *ev = (wxeCommand *)node->GetData(); - if(ev->caller == process) { - batch->Append(ev); - temp->Erase(node); - } - } - } - if(callback_returned) - return; - break; + while((event = batch->Get()) != NULL) { + wxeMemEnv *memenv = getMemEnv(event->port); + // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); + if(event->caller == process || // Callbacks from CB process only + event->op == WXE_CB_START || // Event callback start change process + event->op == WXE_CB_DIED || // Event callback process died + // Allow connect_cb during CB i.e. msg from wxe_server. + (memenv && event->caller == memenv->owner)) { + switch(event->op) { + case -1: + case WXE_BATCH_END: + case WXE_BATCH_BEGIN: + case WXE_DEBUG_PING: + break; + case WXE_CB_RETURN: + if(event->len > 0) { + cb_buff = (char *) driver_alloc(event->len); + memcpy(cb_buff, event->buffer, event->len); + } // continue + case WXE_CB_DIED: + event->Delete(); + return; + case WXE_CB_START: + // CB start from now accept message from CB process only + process = event->caller; + break; + default: + erl_drv_mutex_unlock(wxe_batch_locker_m); + size_t start=temp->m_n; + if(event->op < OPENGL_START) { + // fprintf(stderr, " cb %d \r\n", event->op); + wxe_dispatch(*event); + } else { + gl_dispatch(event->op,event->buffer,event->caller,event->bin); + } + erl_drv_mutex_lock(wxe_batch_locker_m); + if(temp->m_n > start) { + // We have recursed dispatch_cb and messages for this + // callback may be saved on temp list move them + // to orig list + for(unsigned int i=start; i < temp->m_n; i++) { + wxeCommand *ev = &temp->m_q[(temp->m_first+i) % temp->m_max]; + if(ev->caller == process) { + batch->Append(ev); } - event->Delete(); - } else { - // fprintf(stderr, " save %d \r\n", event->op); - temp->Append(event); + } } + break; } - } else { - if(callback_returned) { - return; - } - // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d %d %d \r\n", __FILE__, __LINE__, batch->size(), callback_returned, blevel, is_callback);fflush(stderr); - while(batch->size() == 0) { - erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + event->Delete(); + } else { + // fprintf(stderr, " save %d %lu\r\n", event->op, event->caller); + temp->Append(event); } } + // sleep until something happens + // fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, + // batch->m_n, temp->m_n);fflush(stderr); + while(batch->m_n == 0) { + erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + } } } - /* Memory handling */ void WxeApp::newMemEnv(wxeMetaCommand& Ecmd) { diff --git a/lib/wx/c_src/wxe_impl.h b/lib/wx/c_src/wxe_impl.h index 57bf2e2dba..a0a1c84718 100644 --- a/lib/wx/c_src/wxe_impl.h +++ b/lib/wx/c_src/wxe_impl.h @@ -60,8 +60,8 @@ public: #endif void shutdown(wxeMetaCommand& event); - int dispatch(wxList *, int, int); - void dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process); + int dispatch(wxeFifo *, int, int); + void dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process); void wxe_dispatch(wxeCommand& event); @@ -93,7 +93,7 @@ public: int recurse_level; wxList * delayed_cleanup; - wxList * delayed_delete; + wxeFifo * delayed_delete; // Temp container for callbacks char *cb_buff; int cb_len; diff --git a/lib/wx/examples/demo/demo_html_tagger.erl b/lib/wx/examples/demo/demo_html_tagger.erl index 7bb6736fdc..b119f0e226 100644 --- a/lib/wx/examples/demo/demo_html_tagger.erl +++ b/lib/wx/examples/demo/demo_html_tagger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -267,8 +267,10 @@ normalize_toks(Toks) -> normalize_tok(Tok) -> %% this is the portable way ... - [{_,Type},{_,Line},{_,Col},{_,Txt}] = - erl_scan:token_info(Tok, [category,line,column,text]), + Type = erl_scan:category(Tok), + Line = erl_scan:line(Tok), + Col = erl_scan:column(Tok), + Txt = erl_scan:text(Tok), Val = {Type,{Line,Col},Txt}, %% io:format("here:X=~p ~p~n",[Tok,Val]), Val. diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl index 9b913c7c00..97cb689374 100644 --- a/lib/wx/include/wx.hrl +++ b/lib/wx/include/wx.hrl @@ -54,7 +54,9 @@ -type wxListEventType() :: command_list_begin_drag | command_list_begin_rdrag | command_list_begin_label_edit | command_list_end_label_edit | command_list_delete_item | command_list_delete_all_items | command_list_key_down | command_list_insert_item | command_list_col_click | command_list_col_right_click | command_list_col_begin_drag | command_list_col_dragging | command_list_col_end_drag | command_list_item_selected | command_list_item_deselected | command_list_item_right_click | command_list_item_middle_click | command_list_item_activated | command_list_item_focused | command_list_cache_hint. -type wxList() :: #wxList{}. %% Callback event: {@link wxListEvent} --record(wxNotebook, {type :: wxNotebookEventType()}). %% Callback event: {@link wxNotebookEvent} +-record(wxNotebook,{type :: wxNotebookEventType(), %% Callback event: {@link wxNotebookEvent} + nSel :: integer(), + nOldSel :: integer()}). -type wxNotebookEventType() :: command_notebook_page_changed | command_notebook_page_changing. -type wxNotebook() :: #wxNotebook{}. %% Callback event: {@link wxNotebookEvent} @@ -86,7 +88,9 @@ -type wxWindowDestroyEventType() :: destroy. -type wxWindowDestroy() :: #wxWindowDestroy{}. %% Callback event: {@link wxWindowDestroyEvent} --record(wxCalendar, {type :: wxCalendarEventType()}). %% Callback event: {@link wxCalendarEvent} +-record(wxCalendar,{type :: wxCalendarEventType(), %% Callback event: {@link wxCalendarEvent} + wday :: wx:wx_enum(), + date :: wx:wx_datetime()}). -type wxCalendarEventType() :: calendar_sel_changed | calendar_day_changed | calendar_month_changed | calendar_year_changed | calendar_doubleclicked | calendar_weekday_clicked. -type wxCalendar() :: #wxCalendar{}. %% Callback event: {@link wxCalendarEvent} @@ -100,15 +104,19 @@ -type wxScrollEventType() :: scroll_top | scroll_bottom | scroll_lineup | scroll_linedown | scroll_pageup | scroll_pagedown | scroll_thumbtrack | scroll_thumbrelease | scroll_changed. -type wxScroll() :: #wxScroll{}. %% Callback event: {@link wxScrollEvent} --record(wxMenu, {type :: wxMenuEventType()}). %% Callback event: {@link wxMenuEvent} +-record(wxMenu,{type :: wxMenuEventType(), %% Callback event: {@link wxMenuEvent} + menuId :: integer(), + menu :: wxMenu:wxMenu()}). -type wxMenuEventType() :: menu_open | menu_close | menu_highlight. -type wxMenu() :: #wxMenu{}. %% Callback event: {@link wxMenuEvent} --record(wxContextMenu, {type :: wxContextMenuEventType()}). %% Callback event: {@link wxContextMenuEvent} +-record(wxContextMenu,{type :: wxContextMenuEventType(), %% Callback event: {@link wxContextMenuEvent} + pos :: {X::integer(), Y::integer()}}). -type wxContextMenuEventType() :: context_menu. -type wxContextMenu() :: #wxContextMenu{}. %% Callback event: {@link wxContextMenuEvent} --record(wxShow, {type :: wxShowEventType()}). %% Callback event: {@link wxShowEvent} +-record(wxShow,{type :: wxShowEventType(), %% Callback event: {@link wxShowEvent} + show :: boolean()}). -type wxShowEventType() :: show. -type wxShow() :: #wxShow{}. %% Callback event: {@link wxShowEvent} @@ -117,7 +125,10 @@ -type wxSpinEventType() :: command_spinctrl_updated | spin_up | spin_down | spin. -type wxSpin() :: #wxSpin{}. %% Callback event: {@link wxSpinEvent} --record(wxSetCursor, {type :: wxSetCursorEventType()}). %% Callback event: {@link wxSetCursorEvent} +-record(wxSetCursor,{type :: wxSetCursorEventType(), %% Callback event: {@link wxSetCursorEvent} + x :: integer(), + y :: integer(), + cursor :: wxCursor:wxCursor()}). -type wxSetCursorEventType() :: set_cursor. -type wxSetCursor() :: #wxSetCursor{}. %% Callback event: {@link wxSetCursorEvent} @@ -126,7 +137,9 @@ -type wxFontPickerEventType() :: command_fontpicker_changed. -type wxFontPicker() :: #wxFontPicker{}. %% Callback event: {@link wxFontPickerEvent} --record(wxScrollWin, {type :: wxScrollWinEventType()}). %% Callback event: {@link wxScrollWinEvent} +-record(wxScrollWin,{type :: wxScrollWinEventType(), %% Callback event: {@link wxScrollWinEvent} + commandInt :: integer(), + extraLong :: integer()}). -type wxScrollWinEventType() :: scrollwin_top | scrollwin_bottom | scrollwin_lineup | scrollwin_linedown | scrollwin_pageup | scrollwin_pagedown | scrollwin_thumbtrack | scrollwin_thumbrelease. -type wxScrollWin() :: #wxScrollWin{}. %% Callback event: {@link wxScrollWinEvent} @@ -147,7 +160,8 @@ -type wxFileDirPickerEventType() :: command_filepicker_changed | command_dirpicker_changed. -type wxFileDirPicker() :: #wxFileDirPicker{}. %% Callback event: {@link wxFileDirPickerEvent} --record(wxFocus, {type :: wxFocusEventType()}). %% Callback event: {@link wxFocusEvent} +-record(wxFocus,{type :: wxFocusEventType(), %% Callback event: {@link wxFocusEvent} + win :: wxWindow:wxWindow()}). -type wxFocusEventType() :: set_focus | kill_focus. -type wxFocus() :: #wxFocus{}. %% Callback event: {@link wxFocusEvent} @@ -225,7 +239,8 @@ -type wxSizeEventType() :: size. -type wxSize() :: #wxSize{}. %% Callback event: {@link wxSizeEvent} --record(wxIconize, {type :: wxIconizeEventType()}). %% Callback event: {@link wxIconizeEvent} +-record(wxIconize,{type :: wxIconizeEventType(), %% Callback event: {@link wxIconizeEvent} + iconized :: boolean()}). -type wxIconizeEventType() :: iconize. -type wxIconize() :: #wxIconize{}. %% Callback event: {@link wxIconizeEvent} @@ -289,7 +304,12 @@ -type wxCommandEventType() :: command_button_clicked | command_checkbox_clicked | command_choice_selected | command_listbox_selected | command_listbox_doubleclicked | command_text_updated | command_text_enter | command_menu_selected | command_slider_updated | command_radiobox_selected | command_radiobutton_selected | command_scrollbar_updated | command_vlbox_selected | command_combobox_selected | command_tool_rclicked | command_tool_enter | command_checklistbox_toggled | command_togglebutton_clicked | command_left_click | command_left_dclick | command_right_click | command_set_focus | command_kill_focus | command_enter. -type wxCommand() :: #wxCommand{}. %% Callback event: {@link wxCommandEvent} --record(wxJoystick, {type :: wxJoystickEventType()}). %% Callback event: {@link wxJoystickEvent} +-record(wxJoystick,{type :: wxJoystickEventType(), %% Callback event: {@link wxJoystickEvent} + pos :: {X::integer(), Y::integer()}, + zPosition :: integer(), + buttonChange :: integer(), + buttonState :: integer(), + joyStick :: integer()}). -type wxJoystickEventType() :: joy_button_down | joy_button_up | joy_move | joy_zmove. -type wxJoystick() :: #wxJoystick{}. %% Callback event: {@link wxJoystickEvent} @@ -297,7 +317,9 @@ -type wxQueryNewPaletteEventType() :: query_new_palette. -type wxQueryNewPalette() :: #wxQueryNewPalette{}. %% Callback event: {@link wxQueryNewPaletteEvent} --record(wxMove, {type :: wxMoveEventType()}). %% Callback event: {@link wxMoveEvent} +-record(wxMove,{type :: wxMoveEventType(), %% Callback event: {@link wxMoveEvent} + pos :: {X::integer(), Y::integer()}, + rect :: {X::integer(), Y::integer(), W::integer(), H::integer()}}). -type wxMoveEventType() :: move. -type wxMove() :: #wxMove{}. %% Callback event: {@link wxMoveEvent} diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index b127e6b71d..45ab0f3a32 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -231,8 +231,15 @@ staticBoxSizer(Config) -> clipboard(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); -clipboard(_Config) -> - wx:new(), +clipboard(Config) -> + Wx = wx:new(), + Frame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"), + Ctrl = wxTextCtrl:new(Frame, ?wxID_ANY, [{size, {600,400}}, {style, ?wxTE_MULTILINE}]), + wxTextCtrl:connect(Ctrl, command_text_copy, [{skip, true}]), + wxTextCtrl:connect(Ctrl, command_text_cut, [{skip, true}]), + wxTextCtrl:connect(Ctrl, command_text_paste, [{skip, true}]), + wxWindow:show(Frame), + CB = ?mt(wxClipboard, wxClipboard:get()), wxClipboard:usePrimarySelection(CB), ?m(false, wx:is_null(CB)), @@ -271,7 +278,8 @@ clipboard(_Config) -> ?log("Flushing ~n",[]), wxClipboard:flush(CB), ?log("Stopping ~n",[]), - ok. + wx_test_lib:wx_destroy(Frame,Config). + helpFrame(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); helpFrame(Config) -> diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 3252547c9b..6bcd88e4fb 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -379,25 +379,29 @@ recursive(Config) -> Frame = wxFrame:new(Wx, ?wxID_ANY, "Connect in callback"), Panel = wxPanel:new(Frame, []), Sz = wxBoxSizer:new(?wxVERTICAL), - ListBox = wxListBox:new(Panel, ?wxID_ANY, [{choices, ["foo", "bar", "baz"]}]), - wxSizer:add(Sz, ListBox, [{proportion, 1},{flag, ?wxEXPAND}]), - wxWindow:setSizer(Panel, Sz), - wxListBox:connect(ListBox, command_listbox_selected, - [{callback, - fun(#wx{event=#wxCommand{commandInt=Id}}, _) -> - io:format("Selected ~p~n",[Id]) - end}]), - wxListBox:setSelection(ListBox, 0), - wxListBox:connect(ListBox, size, - [{callback, - fun(#wx{event=#wxSize{}}, _) -> - io:format("Size init ~n",[]), - case wxListBox:getCount(ListBox) > 0 of - true -> wxListBox:delete(ListBox, 0); - false -> ok - end, - io:format("Size done ~n",[]) - end}]), + Ctrl1 = wxTextCtrl:new(Panel, ?wxID_ANY, [{size, {300, -1}}]), + Ctrl2 = wxTextCtrl:new(Panel, ?wxID_ANY, [{size, {300, -1}}]), + wxSizer:add(Sz, Ctrl1, [{proportion, 1},{flag, ?wxEXPAND}]), + wxSizer:add(Sz, Ctrl2, [{proportion, 1},{flag, ?wxEXPAND}]), + wxWindow:setSizerAndFit(Panel, Sz), + + CB1 = fun(#wx{event=#wxCommand{cmdString=String}}, _) -> + io:format(" CB1: ~s~n",[String]), + wxTextCtrl:setValue(Ctrl2, io_lib:format("from CB1 ~s", [String])) + end, + CB2 = fun(#wx{event=#wxCommand{cmdString=String}}, _) -> + io:format(" CB2: ~s~n",[String]), + ok + end, + wxTextCtrl:connect(Ctrl1, command_text_updated, [{callback,CB1}]), + wxTextCtrl:connect(Ctrl2, command_text_updated, [{callback,CB2}]), + wxFrame:connect(Frame, size, + [{callback, + fun(#wx{event=#wxSize{size=Size}}, _) -> + io:format("Size init: ~s ~n",[wxTextCtrl:getValue(Ctrl2)]), + wxTextCtrl:setValue(Ctrl1, io_lib:format("Size ~p", [Size])), + io:format("Size done: ~s ~n",[wxTextCtrl:getValue(Ctrl2)]) + end}]), wxFrame:show(Frame), wx_test_lib:flush(), diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 01af183eef..88eaefc492 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -313,7 +313,7 @@ apply_cb([M|Ms], F, Df, Args, A, Ms0) -> true -> apply(M, F, Args); false -> apply_cb(Ms, F, Df, Args, A, Ms0) end; -apply_cb([], Df, Df, Args, A, _Ms0) -> +apply_cb([], Df, Df, Args, _A, _Ms0) -> exit({unknown_tag, {Df, Args}}); apply_cb([], F, Df, Args, A, Ms0) -> apply_cb(Ms0, Df, Df, [F|Args], A+1). diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index aab2a37d6c..1ed230316f 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.7 +XMERL_VSN = 1.3.8 diff --git a/make/otp_release_targets.mk b/make/otp_release_targets.mk index fcac2ff695..3180a559cc 100644 --- a/make/otp_release_targets.mk +++ b/make/otp_release_targets.mk @@ -44,6 +44,7 @@ $(HTMLDIR)/index.html: $(XML_FILES) $(SPECS_FILES) --stringparam gendate "$$date" \ --stringparam appname "$(APPLICATION)" \ --stringparam appver "$(VSN)" \ + --stringparam extra_front_page_info "$(DOC_EXTRA_FRONT_PAGE_INFO)" \ --stringparam stylesheet "$(CSS_FILE)" \ --stringparam winprefix "$(WINPREFIX)" \ --stringparam logo "$(HTMLLOGO_FILE)" \ @@ -64,6 +65,7 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES) --stringparam gendate "$$date" \ --stringparam appname "$(APPLICATION)" \ --stringparam appver "$(VSN)" \ + --stringparam extra_front_page_info "$(DOC_EXTRA_FRONT_PAGE_INFO)" \ --stringparam stylesheet "$(CSS_FILE)" \ --stringparam winprefix "$(WINPREFIX)" \ --stringparam logo "$(HTMLLOGO_FILE)" \ @@ -80,6 +82,7 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES) --stringparam gendate "$$date" \ --stringparam appname "$(APPLICATION)" \ --stringparam appver "$(VSN)" \ + --stringparam extra_front_page_info "$(DOC_EXTRA_FRONT_PAGE_INFO)" \ --stringparam logo "$(PDFLOGO_FILE)" \ --stringparam pdfcolor "$(PDFCOLOR)" \ --xinclude $(TOP_SPECS_PARAM) \ diff --git a/otp_versions.table b/otp_versions.table index 4bf6cb93b2..12790c88a8 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +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 : OTP-17.5 : asn1-3.0.4 common_test-1.10 compiler-5.0.4 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 diameter-1.9 eldap-1.1.1 erts-6.4 hipe-3.11.3 inets-5.10.6 kernel-3.2 mnesia-4.12.5 observer-2.0.4 os_mon-2.3.1 public_key-0.23 runtime_tools-1.8.16 ssh-3.2 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8 tools-2.7.2 wx-1.3.3 # 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 edoc-0.7.16 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 ic-4.3.6 jinterface-1.5.12 megaco-3.17.3 odbc-2.10.22 orber-3.7.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 reltool-0.6.6 sasl-2.4.1 snmp-5.1.1 typer-0.9.8 webtool-0.8.10 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> |