diff options
Diffstat (limited to 'erts')
224 files changed, 26788 insertions, 6173 deletions
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 264a1726db..352a0ce43c 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1,7 +1,7 @@ dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1998-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1998-2015. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -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)]) @@ -246,31 +245,31 @@ lbl1: return 1; lbl2: return 2; -],ac_cv_prog_emu_cc=$CC,ac_cv_prog_emu_cc=no) +],ac_cv_prog_emu_cc="$CC",ac_cv_prog_emu_cc=no) -if test $ac_cv_prog_emu_cc = no; then +if test "$ac_cv_prog_emu_cc" = no; then for ac_progname in emu_cc.sh gcc-4.2 gcc; do IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_progname; then - ac_cv_prog_emu_cc=$ac_dir/$ac_progname + if test -f "$ac_dir/$ac_progname"; then + ac_cv_prog_emu_cc="$ac_dir/$ac_progname" break fi done IFS="$ac_save_ifs" - if test $ac_cv_prog_emu_cc != no; then + if test "$ac_cv_prog_emu_cc" != no; then break fi done fi -if test $ac_cv_prog_emu_cc != no; then - save_CC=$CC +if test "$ac_cv_prog_emu_cc" != no; then + save_CC="$CC" save_CFLAGS=$CFLAGS save_CPPFLAGS=$CPPFLAGS - CC=$ac_cv_prog_emu_cc + CC="$ac_cv_prog_emu_cc" CFLAGS="" CPPFLAGS="" AC_TRY_COMPILE([],[ @@ -291,17 +290,17 @@ if test $ac_cv_prog_emu_cc != no; then return 1; lbl2: return 2; - ],ac_cv_prog_emu_cc=$CC,ac_cv_prog_emu_cc=no) + ],ac_cv_prog_emu_cc="$CC",ac_cv_prog_emu_cc=no) CC=$save_CC CFLAGS=$save_CFLAGS CPPFLAGS=$save_CPPFLAGS fi ]) -if test $ac_cv_prog_emu_cc = no; then +if test "$ac_cv_prog_emu_cc" = no; then AC_DEFINE(NO_JUMP_TABLE,[],[Defined if no found C compiler can handle jump tables]) - EMU_CC=$CC + EMU_CC="$CC" else - EMU_CC=$ac_cv_prog_emu_cc + EMU_CC="$ac_cv_prog_emu_cc" fi AC_SUBST(EMU_CC) ]) @@ -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> @@ -724,6 +723,244 @@ esac ])# AC_C_DOUBLE_MIDDLE_ENDIAN +AC_DEFUN(ERL_MONOTONIC_CLOCK, +[ + 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, + [ + 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> + ], + [ + struct timespec ts; + long long result; + clock_gettime($clock_type,&ts); + result = ((long long) ts.tv_sec) * 1000000000LL + + ((long long) ts.tv_nsec); + ], + 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, + [ + AC_TRY_COMPILE([ +#include <mach/clock.h> +#include <mach/mach.h> + ], + [ + kern_return_t res; + clock_serv_t clk_srv; + mach_timespec_t time_spec; + + host_get_clock_service(mach_host_self(), SYSTEM_CLOCK, &clk_srv); + res = clock_get_time(clk_srv, &time_spec); + mach_port_deallocate(mach_task_self(), clk_srv); + ], + erl_cv_mach_clock_get_time_monotonic=yes, + erl_cv_mach_clock_get_time_monotonic=no) + ]) + + 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*) + 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 + ;; + CLOCK_*-*-*-*) + erl_monotonic_clock_func=clock_gettime + ;; + no-yes-*-*) + erl_monotonic_clock_func=gethrtime + ;; + no-no-yes-*) + erl_monotonic_clock_func=mach_clock_get_time + ;; + no-no-no-*) + erl_monotonic_clock_func=none + ;; + 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_$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 + +]) + +AC_DEFUN(ERL_WALL_CLOCK, +[ + 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 $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> + ], + [ + struct timespec ts; + long long result; + clock_gettime($clock_type,&ts); + result = ((long long) ts.tv_sec) * 1000000000LL + + ((long long) ts.tv_nsec); + ], + 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, + [ + AC_TRY_COMPILE([ +#include <mach/clock.h> +#include <mach/mach.h> + ], + [ + kern_return_t res; + clock_serv_t clk_srv; + mach_timespec_t time_spec; + + host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &clk_srv); + res = clock_get_time(clk_srv, &time_spec); + mach_port_deallocate(mach_task_self(), clk_srv); + ], + erl_cv_mach_clock_get_time_wall=yes, + erl_cv_mach_clock_get_time_wall=no) + ]) + + erl_wall_clock_low_resolution=no + erl_wall_clock_id= + 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 + erl_wall_clock_id=CALENDAR_CLOCK + ;; + CLOCK_*-*-*-*) + erl_wall_clock_func=clock_gettime + 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 + ;; + *) + erl_wall_clock_func=none + ;; + esac +]) + dnl ---------------------------------------------------------------------- dnl dnl LM_CHECK_THR_LIB @@ -908,24 +1145,226 @@ AC_SUBST(ERTS_INTERNAL_X_LIBS) ]) -AC_DEFUN(ETHR_CHK_SYNC_OP, +AC_DEFUN(ETHR_CHK_GCC_ATOMIC_OP__, [ - AC_MSG_CHECKING([for $3-bit $1()]) - case "$2" in - "1") sync_call="$1(&var);";; - "2") sync_call="$1(&var, ($4) 0);";; - "3") sync_call="$1(&var, ($4) 0, ($4) 0);";; + # $1 - atomic_op + + for atomic_bit_size in 32 64 128; do + case $atomic_bit_size in + 32) gcc_atomic_type="$gcc_atomic_type32";; + 64) gcc_atomic_type="$gcc_atomic_type64";; + 128) gcc_atomic_type="$gcc_atomic_type128";; + esac + gcc_atomic_lockfree="int x[[(2*__atomic_always_lock_free(sizeof($gcc_atomic_type), 0))-1]]" + case $1 in + __sync_add_and_fetch | __sync_fetch_and_and | __sync_fetch_and_or) + atomic_call="volatile $gcc_atomic_type var; $gcc_atomic_type res = $1(&var, ($gcc_atomic_type) 0);" + ;; + __sync_val_compare_and_swap) + atomic_call="volatile $gcc_atomic_type var; $gcc_atomic_type res = $1(&var, ($gcc_atomic_type) 0, ($gcc_atomic_type) 0);" + ;; + __atomic_store_n) + atomic_call="$gcc_atomic_lockfree; volatile $gcc_atomic_type var; $1(&var, ($gcc_atomic_type) 0, __ATOMIC_RELAXED); $1(&var, ($gcc_atomic_type) 0, __ATOMIC_RELEASE);" + ;; + __atomic_load_n) + atomic_call="$gcc_atomic_lockfree; volatile $gcc_atomic_type var; $gcc_atomic_type res = $1(&var, __ATOMIC_RELAXED); res = $1(&var, __ATOMIC_ACQUIRE);" + ;; + __atomic_add_fetch| __atomic_fetch_and | __atomic_fetch_or) + atomic_call="$gcc_atomic_lockfree; volatile $gcc_atomic_type var; $gcc_atomic_type res = $1(&var, ($gcc_atomic_type) 0, __ATOMIC_RELAXED); res = $1(&var, ($gcc_atomic_type) 0, __ATOMIC_ACQUIRE); res = $1(&var, ($gcc_atomic_type) 0, __ATOMIC_RELEASE);" + ;; + __atomic_compare_exchange_n) + atomic_call="$gcc_atomic_lockfree; volatile $gcc_atomic_type var; $gcc_atomic_type val; int res = $1(&var, &val, ($gcc_atomic_type) 0, 0, __ATOMIC_RELAXED, __ATOMIC_RELAXED); res = $1(&var, &val, ($gcc_atomic_type) 0, 0, __ATOMIC_ACQUIRE, __ATOMIC_ACQUIRE);" + ;; + *) + AC_MSG_ERROR([Internal error: missing implementation for $1]) + ;; + esac + eval atomic${atomic_bit_size}_call=\"$atomic_call\" + done + + AC_CACHE_CHECK([for 32-bit $1()], ethr_cv_32bit_$1, + [ + ethr_cv_32bit_$1=no + AC_TRY_LINK([], [$atomic32_call], [ethr_cv_32bit_$1=yes]) + ]) + AC_CACHE_CHECK([for 64-bit $1()], ethr_cv_64bit_$1, + [ + ethr_cv_64bit_$1=no + AC_TRY_LINK([], [$atomic64_call], [ethr_cv_64bit_$1=yes]) + ]) + AC_CACHE_CHECK([for 128-bit $1()], ethr_cv_128bit_$1, + [ + ethr_cv_128bit_$1=no + AC_TRY_LINK([], [$atomic128_call], [ethr_cv_128bit_$1=yes]) + ]) + + case $ethr_cv_128bit_$1-$ethr_cv_64bit_$1-$ethr_cv_32bit_$1 in + no-no-no) + have_atomic_ops=0;; + no-no-yes) + have_atomic_ops=4;; + no-yes-no) + have_atomic_ops=8;; + no-yes-yes) + have_atomic_ops=12;; + yes-no-no) + have_atomic_ops=16;; + yes-no-yes) + have_atomic_ops=20;; + yes-yes-no) + have_atomic_ops=24;; + yes-yes-yes) + have_atomic_ops=28;; + esac + AC_DEFINE_UNQUOTED([ETHR_HAVE_$1], [$have_atomic_ops], [Define as a bitmask corresponding to the word sizes that $1() can handle on your system]) +]) + +AC_DEFUN(ETHR_CHK_IF_NOOP, +[ + ethr_test_filename="chk_if_$1$3_noop_config1test.$$" + cat > "${ethr_test_filename}.c" <<EOF +int +my_test(void) +{ + $1$2; + return 0; +} +EOF + $CC -O3 $ETHR_DEFS -c "${ethr_test_filename}.c" -o "${ethr_test_filename}1.o" + cat > "${ethr_test_filename}.c" <<EOF +int +my_test(void) +{ + ; + return 0; +} +EOF + $CC -O3 $ETHR_DEFS -c "${ethr_test_filename}.c" -o "${ethr_test_filename}2.o" + if diff "${ethr_test_filename}1.o" "${ethr_test_filename}2.o" >/dev/null 2>&1; then + ethr_$1$3_noop=yes + else + ethr_$1$3_noop=no + fi + rm -f "${ethr_test_filename}.c" "${ethr_test_filename}1.o" "${ethr_test_filename}2.o" +]) + +AC_DEFUN(ETHR_CHK_GCC_ATOMIC_OPS, +[ + AC_CHECK_SIZEOF(short) + AC_CHECK_SIZEOF(int) + AC_CHECK_SIZEOF(long) + AC_CHECK_SIZEOF(long long) + AC_CHECK_SIZEOF(__int128_t) + + if test "$ac_cv_sizeof_short" = "4"; then + gcc_atomic_type32="short" + elif test "$ac_cv_sizeof_int" = "4"; then + gcc_atomic_type32="int" + elif test "$ac_cv_sizeof_long" = "4"; then + gcc_atomic_type32="long" + else + AC_MSG_ERROR([No 32-bit type found]) + fi + + if test "$ac_cv_sizeof_int" = "8"; then + gcc_atomic_type64="int" + elif test "$ac_cv_sizeof_long" = "8"; then + gcc_atomic_type64="long" + elif test "$ac_cv_sizeof_long_long" = "8"; then + gcc_atomic_type64="long long" + else + AC_MSG_ERROR([No 64-bit type found]) + fi + + if test "$ac_cv_sizeof___int128_t" = "16"; then + gcc_atomic_type128="__int128_t" + else + gcc_atomic_type128="#error " + fi + AC_CACHE_CHECK([for a working __sync_synchronize()], ethr_cv___sync_synchronize, + [ + ethr_cv___sync_synchronize=no + AC_TRY_LINK([], + [ __sync_synchronize(); ], + [ethr_cv___sync_synchronize=yes]) + if test $ethr_cv___sync_synchronize = yes; then + # + # Old gcc versions on at least x86 have a buggy + # __sync_synchronize() which does not emit a + # memory barrier. We try to detect this by + # compiling to assembly with and without + # __sync_synchronize() and compare the results. + # + ETHR_CHK_IF_NOOP(__sync_synchronize, [()], []) + if test $ethr___sync_synchronize_noop = yes; then + # Got a buggy implementation of + # __sync_synchronize... + ethr_cv___sync_synchronize="no; buggy implementation" + fi + fi + ]) + + if test "$ethr_cv___sync_synchronize" = "yes"; then + have_sync_synchronize_value="~0" + else + have_sync_synchronize_value="0" + fi + AC_DEFINE_UNQUOTED([ETHR_HAVE___sync_synchronize], [$have_sync_synchronize_value], [Define as a bitmask corresponding to the word sizes that __sync_synchronize() can handle on your system]) + + ETHR_CHK_GCC_ATOMIC_OP__(__sync_add_and_fetch) + ETHR_CHK_GCC_ATOMIC_OP__(__sync_fetch_and_and) + ETHR_CHK_GCC_ATOMIC_OP__(__sync_fetch_and_or) + ETHR_CHK_GCC_ATOMIC_OP__(__sync_val_compare_and_swap) + + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_store_n) + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_load_n) + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_add_fetch) + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_fetch_and) + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_fetch_or) + ETHR_CHK_GCC_ATOMIC_OP__(__atomic_compare_exchange_n) + + ethr_have_gcc_native_atomics=no + ethr_arm_dbm_instr_val=0 + case "$GCC-$host_cpu" in + yes-arm*) + AC_CACHE_CHECK([for ARM DMB instruction], ethr_cv_arm_dbm_instr, + [ + ethr_cv_arm_dbm_instr=no + AC_TRY_LINK([], + [ + __asm__ __volatile__("dmb sy" : : : "memory"); + __asm__ __volatile__("dmb st" : : : "memory"); + ], + [ethr_cv_arm_dbm_instr=yes]) + ]) + if test $ethr_cv_arm_dbm_instr = yes; then + ethr_arm_dbm_instr_val=1 + test $ethr_cv_64bit___atomic_compare_exchange_n = yes && + ethr_have_gcc_native_atomics=yes + fi;; + *) + ;; esac - have_sync_op=no - AC_TRY_LINK([], - [ - $4 res; - volatile $4 var; - res = $sync_call - ], - [have_sync_op=yes]) - test $have_sync_op = yes && $5 - AC_MSG_RESULT([$have_sync_op]) + AC_DEFINE_UNQUOTED([ETHR_HAVE_GCC_ASM_ARM_DMB_INSTRUCTION], [$ethr_arm_dbm_instr_val], [Define as a boolean indicating whether you have a gcc compatible compiler capable of generating the ARM DMB instruction, and are compiling for an ARM processor with ARM DMB instruction support, or not]) + test $ethr_cv_32bit___sync_val_compare_and_swap = yes && + ethr_have_gcc_native_atomics=yes + test $ethr_cv_64bit___sync_val_compare_and_swap = yes && + ethr_have_gcc_native_atomics=yes + if test "$ethr_cv___sync_synchronize" = "yes"; then + test $ethr_cv_64bit___atomic_compare_exchange_n = yes && + ethr_have_gcc_native_atomics=yes + test $ethr_cv_32bit___atomic_compare_exchange_n = yes && + ethr_have_gcc_native_atomics=yes + fi + ethr_have_gcc_atomic_builtins=0 + if test $ethr_have_gcc_native_atomics = yes; then + ethr_native_atomic_implementation=gcc_sync + test $ethr_cv_32bit___atomic_compare_exchange_n = yes && ethr_have_gcc_atomic_builtins=1 + test $ethr_cv_64bit___atomic_compare_exchange_n = yes && ethr_have_gcc_atomic_builtins=1 + test $ethr_have_gcc_atomic_builtins = 1 && ethr_native_atomic_implementation=gcc_atomic_sync + fi + AC_DEFINE_UNQUOTED([ETHR_HAVE_GCC___ATOMIC_BUILTINS], [$ethr_have_gcc_atomic_builtins], [Define as a boolean indicating whether you have a gcc __atomic builtins or not]) + test $ethr_have_gcc_native_atomics = yes && ethr_have_native_atomics=yes ]) AC_DEFUN(ETHR_CHK_INTERLOCKED, @@ -1005,6 +1444,16 @@ AC_ARG_ENABLE(prefer-gcc-native-ethr-impls, test $enable_prefer_gcc_native_ethr_impls = yes && AC_DEFINE(ETHR_PREFER_GCC_NATIVE_IMPLS, 1, [Define if you prefer gcc native ethread implementations]) +AC_ARG_ENABLE(trust-gcc-atomic-builtins-memory-barriers, + AS_HELP_STRING([--enable-trust-gcc-atomic-builtins-memory-barriers], + [trust gcc atomic builtins memory barriers]), +[ case "$enableval" in + yes) trust_gcc_atomic_builtins_mbs=1 ;; + *) trust_gcc_atomic_builtins_mbs=0 ;; + esac ], trust_gcc_atomic_builtins_mbs=0) + +AC_DEFINE_UNQUOTED(ETHR_TRUST_GCC_ATOMIC_BUILTINS_MEMORY_BARRIERS, [$trust_gcc_atomic_builtins_mbs], [Define as a boolean indicating whether you trust gcc's __atomic_* builtins memory barrier implementations, or not]) + AC_ARG_WITH(libatomic_ops, AS_HELP_STRING([--with-libatomic_ops=PATH], [specify and prefer usage of libatomic_ops in the ethread library])) @@ -1016,12 +1465,33 @@ AC_ARG_WITH(with_sparc_memory_order, LM_CHECK_THR_LIB ERL_INTERNAL_LIBS +ERL_MONOTONIC_CLOCK(high_resolution) + +case $erl_monotonic_clock_func in + clock_gettime) + AC_DEFINE(ETHR_HAVE_CLOCK_GETTIME_MONOTONIC, [1], [Define if you have a clock_gettime() with a monotonic clock]) + ;; + mach_clock_get_time) + AC_DEFINE(ETHR_HAVE_MACH_CLOCK_GET_TIME, [1], [Define if you have a mach clock_get_time() with a monotonic clock]) + ;; + gethrtime) + AC_DEFINE(ETHR_HAVE_GETHRTIME, [1], [Define if you have a monotonic gethrtime()]) + ;; + *) + ;; +esac + +if test "x$erl_monotonic_clock_id" != "x"; then + AC_DEFINE_UNQUOTED(ETHR_MONOTONIC_CLOCK_ID, [$erl_monotonic_clock_id], [Define to the monotonic clock id to use]) +fi + +ethr_native_atomic_implementation=none ethr_have_native_atomics=no ethr_have_native_spinlock=no ETHR_THR_LIB_BASE="$THR_LIB_NAME" ETHR_THR_LIB_BASE_TYPE="$THR_LIB_TYPE" ETHR_DEFS="$THR_DEFS" -ETHR_X_LIBS="$THR_LIBS $ERTS_INTERNAL_X_LIBS" +ETHR_X_LIBS="$THR_LIBS $ERTS_INTERNAL_X_LIBS $erl_monotonic_clock_lib" ETHR_LIBS= ETHR_LIB_NAME= @@ -1100,7 +1570,10 @@ case "$THR_LIB_NAME" in ETHR_CHK_INTERLOCKED([_InterlockedCompareExchange128], [4], [__int64], AC_DEFINE_UNQUOTED(ETHR_HAVE__INTERLOCKEDCOMPAREEXCHANGE128, 1, [Define if you have _InterlockedCompareExchange128()])) fi - test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes + if test "$ethr_have_native_atomics" = "yes"; then + ethr_native_atomic_implementation=windows + ethr_have_native_spinlock=yes + fi ;; pthread|ose_threads) @@ -1329,6 +1802,50 @@ case "$THR_LIB_NAME" in AC_DEFINE(ETHR_HAVE_PTHREAD_ATTR_SETGUARDSIZE, 1, \ [Define if you have the pthread_attr_setguardsize function.])) + if test "x$erl_monotonic_clock_id" != "x"; then + AC_MSG_CHECKING(whether pthread_cond_timedwait() can use the monotonic clock $erl_monotonic_clock_id for timeout) + pthread_cond_timedwait_monotonic=no + AC_TRY_LINK([ + #if defined(ETHR_NEED_NPTL_PTHREAD_H) + # include <nptl/pthread.h> + #elif defined(ETHR_HAVE_MIT_PTHREAD_H) + # include <pthread/mit/pthread.h> + #elif defined(ETHR_HAVE_PTHREAD_H) + # include <pthread.h> + #endif + #ifdef ETHR_TIME_WITH_SYS_TIME + # include <time.h> + # include <sys/time.h> + #else + # ifdef ETHR_HAVE_SYS_TIME_H + # include <sys/time.h> + # else + # include <time.h> + # endif + #endif + #if defined(ETHR_HAVE_MACH_CLOCK_GET_TIME) + # include <mach/clock.h> + # include <mach/mach.h> + #endif + ], + [ + int res; + pthread_condattr_t attr; + pthread_cond_t cond; + struct timespec cond_timeout; + pthread_mutex_t mutex; + res = pthread_condattr_init(&attr); + res = pthread_condattr_setclock(&attr, ETHR_MONOTONIC_CLOCK_ID); + res = pthread_cond_init(&cond, &attr); + res = pthread_cond_timedwait(&cond, &mutex, &cond_timeout); + ], + [pthread_cond_timedwait_monotonic=yes]) + AC_MSG_RESULT([$pthread_cond_timedwait_monotonic]) + if test $pthread_cond_timedwait_monotonic = yes; then + AC_DEFINE(ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC, [1], [Define if pthread_cond_timedwait() can be used with a monotonic clock]) + fi + fi + linux_futex=no AC_MSG_CHECKING([for Linux futexes]) AC_TRY_LINK([ @@ -1400,54 +1917,11 @@ case "$THR_LIB_NAME" in fi ## test "x$THR_LIB_NAME" = "xpthread" - AC_CHECK_SIZEOF(int) - AC_CHECK_SIZEOF(long) - AC_CHECK_SIZEOF(long long) - AC_CHECK_SIZEOF(__int128_t) - - if test "$ac_cv_sizeof_int" = "4"; then - int32="int" - elif test "$ac_cv_sizeof_long" = "4"; then - int32="long" - elif test "$ac_cv_sizeof_long_long" = "4"; then - int32="long long" - else - AC_MSG_ERROR([No 32-bit type found]) - fi - - if test "$ac_cv_sizeof_int" = "8"; then - int64="int" - elif test "$ac_cv_sizeof_long" = "8"; then - int64="long" - elif test "$ac_cv_sizeof_long_long" = "8"; then - int64="long long" - else - AC_MSG_ERROR([No 64-bit type found]) - fi - - int128=no - if test "$ac_cv_sizeof___int128_t" = "16"; then - int128="__int128_t" - fi - if test "X$disable_native_ethr_impls" = "Xyes"; then ethr_have_native_atomics=no else - ETHR_CHK_SYNC_OP([__sync_val_compare_and_swap], [3], [32], [$int32], AC_DEFINE(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP32, 1, [Define if you have __sync_val_compare_and_swap() for 32-bit integers])) - test "$have_sync_op" = "yes" && ethr_have_native_atomics=yes - ETHR_CHK_SYNC_OP([__sync_add_and_fetch], [2], [32], [$int32], AC_DEFINE(ETHR_HAVE___SYNC_ADD_AND_FETCH32, 1, [Define if you have __sync_add_and_fetch() for 32-bit integers])) - ETHR_CHK_SYNC_OP([__sync_fetch_and_and], [2], [32], [$int32], AC_DEFINE(ETHR_HAVE___SYNC_FETCH_AND_AND32, 1, [Define if you have __sync_fetch_and_and() for 32-bit integers])) - ETHR_CHK_SYNC_OP([__sync_fetch_and_or], [2], [32], [$int32], AC_DEFINE(ETHR_HAVE___SYNC_FETCH_AND_OR32, 1, [Define if you have __sync_fetch_and_or() for 32-bit integers])) - - ETHR_CHK_SYNC_OP([__sync_val_compare_and_swap], [3], [64], [$int64], AC_DEFINE(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64, 1, [Define if you have __sync_val_compare_and_swap() for 64-bit integers])) - test "$have_sync_op" = "yes" && ethr_have_native_atomics=yes - ETHR_CHK_SYNC_OP([__sync_add_and_fetch], [2], [64], [$int64], AC_DEFINE(ETHR_HAVE___SYNC_ADD_AND_FETCH64, 1, [Define if you have __sync_add_and_fetch() for 64-bit integers])) - ETHR_CHK_SYNC_OP([__sync_fetch_and_and], [2], [64], [$int64], AC_DEFINE(ETHR_HAVE___SYNC_FETCH_AND_AND64, 1, [Define if you have __sync_fetch_and_and() for 64-bit integers])) - ETHR_CHK_SYNC_OP([__sync_fetch_and_or], [2], [64], [$int64], AC_DEFINE(ETHR_HAVE___SYNC_FETCH_AND_OR64, 1, [Define if you have __sync_fetch_and_or() for 64-bit integers])) - - if test $int128 != no; then - ETHR_CHK_SYNC_OP([__sync_val_compare_and_swap], [3], [128], [$int128], AC_DEFINE(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP128, 1, [Define if you have __sync_val_compare_and_swap() for 128-bit integers])) - fi + + ETHR_CHK_GCC_ATOMIC_OPS([]) AC_MSG_CHECKING([for a usable libatomic_ops implementation]) case "x$with_libatomic_ops" in @@ -1497,6 +1971,7 @@ case "$THR_LIB_NAME" in #endif ], [ethr_have_native_atomics=yes + ethr_native_atomic_implementation=libatomic_ops ethr_have_libatomic_ops=yes]) AC_MSG_RESULT([$ethr_have_libatomic_ops]) if test $ethr_have_libatomic_ops = yes; then @@ -1528,15 +2003,19 @@ case "$THR_LIB_NAME" in *) AC_MSG_ERROR([Unsupported Sparc memory order: $with_sparc_memory_order]);; esac + ethr_native_atomic_implementation=ethread ethr_have_native_atomics=yes;; i86pc | i*86 | x86_64 | amd64) if test "$enable_x86_out_of_order" = "yes"; then AC_DEFINE(ETHR_X86_OUT_OF_ORDER, 1, [Define if x86/x86_64 out of order instructions should be synchronized]) fi + ethr_native_atomic_implementation=ethread ethr_have_native_atomics=yes;; macppc | ppc | powerpc | "Power Macintosh") + ethr_native_atomic_implementation=ethread ethr_have_native_atomics=yes;; tile) + ethr_native_atomic_implementation=ethread ethr_have_native_atomics=yes;; *) ;; @@ -1709,109 +2188,199 @@ AC_SUBST(ETHR_X86_SSE2_ASM) ]) - 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, -[if test x$ac_cv_func_gethrtime = x; then - AC_CHECK_FUNC(gethrtime) -fi -if test x$clock_gettime_correction = xunknown; then - AC_TRY_COMPILE([#include <time.h>], - [struct timespec ts; - long long result; - clock_gettime(CLOCK_MONOTONIC,&ts); - result = ((long long) ts.tv_sec) * 1000000000LL + - ((long long) ts.tv_nsec);], - clock_gettime_compiles=yes, - clock_gettime_compiles=no) -else - clock_gettime_compiles=no +[ + +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) + AC_DEFINE(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME, [1], [Define if you want to implement erts_os_system_time() using mach clock_get_time()]) + ;; + clock_gettime) + AC_DEFINE(OS_SYSTEM_TIME_USING_CLOCK_GETTIME, [1], [Define if you want to implement erts_os_system_time() using clock_gettime()]) + ;; + gettimeofday) + AC_DEFINE(OS_SYSTEM_TIME_GETTIMEOFDAY, [1], [Define if you want to implement erts_os_system_time() using gettimeofday()]) + ;; + *) + ;; +esac + +if test "x$erl_wall_clock_id" != "x"; then + AC_DEFINE_UNQUOTED(WALL_CLOCK_ID_STR, ["$erl_wall_clock_id"], [Define as a string of wall clock id to use]) + AC_DEFINE_UNQUOTED(WALL_CLOCK_ID, [$erl_wall_clock_id], [Define to wall clock id to use]) fi - -AC_CACHE_CHECK([how to correct for time adjustments], erl_cv_time_correction, -[ -case $clock_gettime_correction in - yes) - erl_cv_time_correction=clock_gettime;; - no|unknown) - case $ac_cv_func_gethrtime in - yes) - erl_cv_time_correction=hrtime ;; - no) - case $host_os in - linux*) - case $clock_gettime_correction in - unknown) - if test x$clock_gettime_compiles = xyes; then - 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_cv_time_correction=times ;; - *) - erl_cv_time_correction=clock_gettime;; - esac - else - case X$erl_xcomp_linux_clock_gettime_correction in - X) - erl_cv_time_correction=cross;; - Xyes|Xno) - if test $erl_xcomp_linux_clock_gettime_correction = yes; then - erl_cv_time_correction=clock_gettime - else - erl_cv_time_correction=times - fi;; - *) - AC_MSG_ERROR([Bad erl_xcomp_linux_clock_gettime_correction value: $erl_xcomp_linux_clock_gettime_correction]);; - esac - fi - else - erl_cv_time_correction=times - fi - ;; - *) - erl_cv_time_correction=times ;; - esac - ;; - *) - erl_cv_time_correction=none ;; - esac - ;; - esac - ;; +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 -]) -xrtlib="" -case $erl_cv_time_correction in +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) - AC_DEFINE(CORRECT_USING_TIMES,[], - [Define if you do not have a high-res. timer & want to use times() instead]) + AC_DEFINE(OS_MONOTONIC_TIME_USING_TIMES, [1], [Define if you want to implement erts_os_monotonic_time() using times()]) ;; - clock_gettime|cross) - if test $erl_cv_time_correction = cross; then - erl_cv_time_correction=clock_gettime - AC_MSG_WARN([result clock_gettime guessed because of cross compilation]) - fi - xrtlib="-lrt" - AC_DEFINE(GETHRTIME_WITH_CLOCK_GETTIME,[1], - [Define if you want to use clock_gettime to simulate gethrtime]) + mach_clock_get_time) + AC_DEFINE(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME, [1], [Define if you want to implement erts_os_monotonic_time() using mach clock_get_time()]) + ;; + clock_gettime) + AC_DEFINE(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME, [1], [Define if you want to implement erts_os_monotonic_time() using clock_gettime()]) + ;; + gethrtime) + AC_DEFINE(OS_MONOTONIC_TIME_USING_GETHRTIME, [1], [Define if you want to implement erts_os_monotonic_time() using gethrtime()]) + ;; + *) + ;; +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. @@ -1884,6 +2453,7 @@ case X$erl_xcomp_gethrvtime_procfs_ioctl in esac ]) +LIBRT=$xrtlib case $erl_gethrvtime in procfs_ioctl) AC_DEFINE(HAVE_GETHRVTIME_PROCFS_IOCTL,[1], @@ -1950,15 +2520,13 @@ case $erl_gethrvtime in cross) erl_clock_gettime_cpu_time=no AC_MSG_WARN([result no guessed because of cross compilation]) - LIBRT=$xrtlib ;; *) - LIBRT=$xrtlib ;; esac - AC_SUBST(LIBRT) ;; esac +AC_SUBST(LIBRT) ])dnl dnl ---------------------------------------------------------------------- diff --git a/erts/autoconf/config.guess b/erts/autoconf/config.guess index f475ceb413..f7eb141e75 100755 --- a/erts/autoconf/config.guess +++ b/erts/autoconf/config.guess @@ -1,8 +1,8 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2013 Free Software Foundation, Inc. +# Copyright 1992-2015 Free Software Foundation, Inc. -timestamp='2013-02-12' +timestamp='2015-03-04' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -24,12 +24,12 @@ timestamp='2013-02-12' # program. This Exception is an additional permission under section 7 # of the GNU General Public License, version 3 ("GPLv3"). # -# Originally written by Per Bothner. +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from: # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# Please send patches with a ChangeLog entry to [email protected]. +# Please send patches to <[email protected]>. me=`echo "$0" | sed -e 's,.*/,,'` @@ -50,7 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2013 Free Software Foundation, Inc. +Copyright 1992-2015 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -132,6 +132,27 @@ UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown +case "${UNAME_SYSTEM}" in +Linux|GNU|GNU/*) + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + LIBC=gnu + + eval $set_cc_for_build + cat <<-EOF > $dummy.c + #include <features.h> + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #else + LIBC=gnu + #endif + EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` + ;; +esac + # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in @@ -147,20 +168,27 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ - /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ + /sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || \ + echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; sh5el) machine=sh5le-unknown ;; + earmv*) + arch=`echo ${UNAME_MACHINE_ARCH} | sed -e 's,^e\(armv[0-9]\).*$,\1,'` + endian=`echo ${UNAME_MACHINE_ARCH} | sed -ne 's,^.*\(eb\)$,\1,p'` + machine=${arch}${endian}-unknown + ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in - arm*|i386|m68k|ns32k|sh3*|sparc|vax) + arm*|earm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ELF__ @@ -176,6 +204,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in os=netbsd ;; esac + # Determine ABI tags. + case "${UNAME_MACHINE_ARCH}" in + earm*) + expr='s/^earmv[0-9]/-eabi/;s/eb$//' + abi=`echo ${UNAME_MACHINE_ARCH} | sed -e "$expr"` + ;; + esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need @@ -192,7 +227,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" + echo "${machine}-${os}${release}${abi}" exit ;; *:Bitrig:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` @@ -558,8 +593,9 @@ EOF else IBM_ARCH=powerpc fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` + if [ -x /usr/bin/lslpp ] ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi @@ -805,7 +841,7 @@ EOF *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; - i*:MSYS*:*) + *:MSYS*:*) echo ${UNAME_MACHINE}-pc-msys exit ;; i*:windows32*:*) @@ -853,21 +889,21 @@ EOF exit ;; *:GNU:*:*) # the GNU system - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland - echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; aarch64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; aarch64_be:Linux:*:*) UNAME_MACHINE=aarch64_be - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in @@ -880,59 +916,57 @@ EOF EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + if test "$?" = 0 ; then LIBC="gnulibc1" ; fi + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; arm*:Linux:*:*) eval $set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} else if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_PCS_VFP then - echo ${UNAME_MACHINE}-unknown-linux-gnueabi + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi else - echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf fi fi exit ;; avr32*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; cris:Linux:*:*) - echo ${UNAME_MACHINE}-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-${LIBC} exit ;; crisv32:Linux:*:*) - echo ${UNAME_MACHINE}-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + e2k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; frv:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; hexagon:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; i*86:Linux:*:*) - LIBC=gnu - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" + echo ${UNAME_MACHINE}-pc-linux-${LIBC} exit ;; ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; m32r*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build @@ -951,57 +985,63 @@ EOF #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } ;; - or1k:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + openrisc*:Linux:*:*) + echo or1k-unknown-linux-${LIBC} exit ;; - or32:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + or32:Linux:*:* | or1k*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; padre:Linux:*:*) - echo sparc-unknown-linux-gnu + echo sparc-unknown-linux-${LIBC} exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + echo hppa64-unknown-linux-${LIBC} exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-gnu ;; - PA8*) echo hppa2.0-unknown-linux-gnu ;; - *) echo hppa-unknown-linux-gnu ;; + PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; + PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; + *) echo hppa-unknown-linux-${LIBC} ;; esac exit ;; ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + echo powerpc64-unknown-linux-${LIBC} exit ;; ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + echo powerpc-unknown-linux-${LIBC} + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-${LIBC} + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-${LIBC} exit ;; s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux + echo ${UNAME_MACHINE}-ibm-linux-${LIBC} exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; sh*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; tile*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; vax:Linux:*:*) - echo ${UNAME_MACHINE}-dec-linux-gnu + echo ${UNAME_MACHINE}-dec-linux-${LIBC} exit ;; x86_64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; xtensa*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. @@ -1234,19 +1274,31 @@ EOF exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - case $UNAME_PROCESSOR in - i386) - eval $set_cc_for_build - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - UNAME_PROCESSOR="x86_64" - fi - fi ;; - unknown) UNAME_PROCESSOR=powerpc ;; - esac + eval $set_cc_for_build + if test "$UNAME_PROCESSOR" = unknown ; then + UNAME_PROCESSOR=powerpc + fi + if test `echo "$UNAME_RELEASE" | sed -e 's/\..*//'` -le 10 ; then + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # Avoid executing cc on OS X 10.9, as it ships with a stub + # that puts up a graphical alert prompting to install + # developer tools. Any system running Mac OS X 10.7 or + # later (Darwin 11 and later) is required to have a 64-bit + # processor. This is not true of the ARM version of Darwin + # that Apple uses in portable devices. + UNAME_PROCESSOR=x86_64 + fi echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) @@ -1337,154 +1389,6 @@ EOF exit ;; esac -eval $set_cc_for_build -cat >$dummy.c <<EOF -#ifdef _SEQUENT_ -# include <sys/types.h> -# include <sys/utsname.h> -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include <sys/param.h> - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix\n"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -# if !defined (ultrix) -# include <sys/param.h> -# if defined (BSD) -# if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -# else -# if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# endif -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# else - printf ("vax-dec-ultrix\n"); exit (0); -# endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - c34*) - echo c34-convex-bsd - exit ;; - c38*) - echo c38-convex-bsd - exit ;; - c4*) - echo c4-convex-bsd - exit ;; - esac -fi - cat >&2 <<EOF $0: unable to guess system type diff --git a/erts/autoconf/config.sub b/erts/autoconf/config.sub index bb6edbdb47..8f1229c6f7 100755 --- a/erts/autoconf/config.sub +++ b/erts/autoconf/config.sub @@ -1,8 +1,8 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2013 Free Software Foundation, Inc. +# Copyright 1992-2015 Free Software Foundation, Inc. -timestamp='2013-02-12' +timestamp='2015-03-08' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -25,7 +25,7 @@ timestamp='2013-02-12' # of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches with a ChangeLog entry to [email protected]. +# Please send patches to <[email protected]>. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. @@ -68,7 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright 1992-2013 Free Software Foundation, Inc. +Copyright 1992-2015 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -117,7 +117,7 @@ maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ - knetbsd*-gnu* | netbsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | netbsd*-eabi* | \ kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os @@ -252,19 +252,20 @@ case $basic_machine in | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc \ + | arc | arceb \ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ | avr | avr32 \ | be32 | be64 \ | bfin \ - | c4x | clipper \ + | c4x | c8051 | clipper \ | d10v | d30v | dlx | dsp16xx \ - | epiphany \ - | fido | fr30 | frv \ + | e2k | epiphany \ + | fido | fr30 | frv | ft32 \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | k1om \ | le32 | le64 \ | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ @@ -282,8 +283,10 @@ case $basic_machine in | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ + | mipsisa32r6 | mipsisa32r6el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64r6 | mipsisa64r6el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipsr5900 | mipsr5900el \ @@ -295,11 +298,11 @@ case $basic_machine in | nds32 | nds32le | nds32be \ | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | open8 \ - | or1k | or32 \ + | open8 | or1k | or1knd | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | riscv32 | riscv64 \ | rl78 | rx \ | score \ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ @@ -310,6 +313,7 @@ case $basic_machine in | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ | ubicom32 \ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ + | visium \ | we32k \ | x86 | xc16x | xstormy16 | xtensa \ | z8k | z80) @@ -324,7 +328,10 @@ case $basic_machine in c6x) basic_machine=tic6x-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) + leon|leon[3-9]) + basic_machine=sparc-$basic_machine + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -366,21 +373,22 @@ case $basic_machine in | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ | be32-* | be64-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* \ - | clipper-* | craynv-* | cydra-* \ + | c8051-* | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ - | elxsi-* \ + | e2k-* | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | k1om-* \ | le32-* | le64-* \ | lm32-* \ | m32c-* | m32r-* | m32rle-* \ @@ -400,8 +408,10 @@ case $basic_machine in | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa32r6-* | mipsisa32r6el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64r6-* | mipsisa64r6el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipsr5900-* | mipsr5900el-* \ @@ -413,6 +423,7 @@ case $basic_machine in | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | open8-* \ + | or1k*-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ @@ -430,6 +441,7 @@ case $basic_machine in | ubicom32-* \ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ | vax-* \ + | visium-* \ | we32k-* \ | x86-* | x86_64-* | xc16x-* | xps100-* \ | xstormy16-* | xtensa*-* \ @@ -506,6 +518,9 @@ case $basic_machine in basic_machine=i386-pc os=-aros ;; + asmjs) + basic_machine=asmjs-unknown + ;; aux) basic_machine=m68k-apple os=-aux @@ -767,6 +782,9 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + leon-*|leon[3-9]-*) + basic_machine=sparc-`echo $basic_machine | sed 's/-.*//'` + ;; m68knommu) basic_machine=m68k-unknown os=-linux @@ -794,7 +812,7 @@ case $basic_machine in os=-mingw64 ;; mingw32) - basic_machine=i386-pc + basic_machine=i686-pc os=-mingw32 ;; mingw32ce) @@ -822,6 +840,10 @@ case $basic_machine in basic_machine=powerpc-unknown os=-morphos ;; + moxiebox) + basic_machine=moxie-unknown + os=-moxiebox + ;; msdos) basic_machine=i386-pc os=-msdos @@ -830,7 +852,7 @@ case $basic_machine in basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; msys) - basic_machine=i386-pc + basic_machine=i686-pc os=-msys ;; mvs) @@ -1354,7 +1376,7 @@ case $os in | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* | -aros* \ + | -aos* | -aros* | -cloudabi* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ @@ -1367,14 +1389,14 @@ case $os in | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ | -linux-newlib* | -linux-musl* | -linux-uclibc* \ - | -uxpv* | -beos* | -mpeix* | -udk* \ + | -uxpv* | -beos* | -mpeix* | -udk* | -moxiebox* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es* | -tirtos*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1546,6 +1568,9 @@ case $basic_machine in c4x-* | tic4x-*) os=-coff ;; + c8051-*) + os=-elf + ;; hexagon-*) os=-elf ;; @@ -1589,9 +1614,6 @@ case $basic_machine in mips*-*) os=-elf ;; - or1k-*) - os=-elf - ;; or32-*) os=-coff ;; @@ -1786,4 +1808,3 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: - diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static index b387db2b22..b3328e5414 100755 --- a/erts/autoconf/win32.config.cache.static +++ b/erts/autoconf/win32.config.cache.static @@ -221,7 +221,6 @@ ac_cv_type_size_t=${ac_cv_type_size_t=yes} ac_cv_type_uid_t=${ac_cv_type_uid_t=no} ac_cv_type_void_p=${ac_cv_type_void_p=yes} ac_cv_working_alloca_h=${ac_cv_working_alloca_h=no} -erl_cv_time_correction=${erl_cv_time_correction=none} erts_cv___after_morecore_hook_can_track_malloc=${erts_cv___after_morecore_hook_can_track_malloc=no} erts_cv_fwrite_unlocked=${erts_cv_fwrite_unlocked=no} erts_cv_have__end_symbol=${erts_cv_have__end_symbol=no} diff --git a/erts/autoconf/win64.config.cache.static b/erts/autoconf/win64.config.cache.static index a8a2bfb59c..c7d92c7000 100755 --- a/erts/autoconf/win64.config.cache.static +++ b/erts/autoconf/win64.config.cache.static @@ -262,7 +262,6 @@ ac_cv_type_signal=${ac_cv_type_signal=void} ac_cv_type_size_t=${ac_cv_type_size_t=yes} ac_cv_type_uid_t=${ac_cv_type_uid_t=no} ac_cv_working_alloca_h=${ac_cv_working_alloca_h=no} -erl_cv_time_correction=${erl_cv_time_correction=none} erts_cv___after_morecore_hook_can_track_malloc=${erts_cv___after_morecore_hook_can_track_malloc=no} erts_cv_fwrite_unlocked=${erts_cv_fwrite_unlocked=no} erts_cv_have__end_symbol=${erts_cv_have__end_symbol=no} diff --git a/erts/configure.in b/erts/configure.in index f248cbe34d..8a9bf30433 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2015. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except 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)])) @@ -631,7 +622,7 @@ fi case $chk_opsys_ in win32) OPSYS=win32;; solaris2.*|SunOS5.*) OPSYS=sol2;; - linux|Linux) OPSYS=linux;; + linux*|Linux) OPSYS=linux;; darwin|Darwin) OPSYS=darwin;; freebsd|FreeBSD) OPSYS=freebsd;; *) OPSYS=noopsys @@ -1105,10 +1096,31 @@ if test $ERTS_BUILD_SMP_EMU = yes; then case "$ethr_have_native_atomics-$smp_require_native_atomics-$ethr_have_native_spinlock" in yes-*) + if test "$ethr_native_atomic_implementation" = "gcc_sync"; then + test -f "$ERL_TOP/erts/CONF_INFO" || + echo "" > "$ERL_TOP/erts/CONF_INFO" + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + WARNING: + Only gcc's __sync_* builtins available for + atomic memory access. This will cause lots + of expensive and unnecessary memory barrier + instructions to be issued which will make + the performance of the runtime system + suffer. You are *strongly* advised to + upgrade to a gcc version that supports the + __atomic_* builtins (at least gcc version + 4.7) or build with libatomic_ops. See the + "Atomic Memory Operations and the VM" + chapter of \$ERL_TOP/HOWTO/INSTALL.md for + more information. + +EOF + fi ;; no-yes-*) - AC_MSG_ERROR([No native atomic implementation found. See Configuring section in INSTALL.md for more information.]) + AC_MSG_ERROR([No native atomic implementation found. See the \"Atomic Memory Operations and the VM\" chapter of \$ERL_TOP/HOWTO/INSTALL.md for more information.]) ;; no-no-yes) @@ -1537,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])) ;; @@ -2895,6 +2908,10 @@ else #include <signal.h> #include <stdlib.h> +#if defined(__clang__) || defined(__llvm__) +#error "Clang/LLVM generates broken code for FP exceptions" +#endif + volatile int erl_fp_exception; /* @@ -4272,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 @@ -4470,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]) @@ -4670,18 +4687,30 @@ AC_SUBST(os_mon_programs) AC_SUBST(CPU_SUP_LIBS) AC_CHECK_LIB(kstat, kstat_open, [ - os_mon_programs="$os_mon_programs cpu_sup" + use_cpu_sup=yes CPU_SUP_LIBS="$CPU_SUP_LIBS -lkstat" ]) +AC_CHECK_LIB(kvm, kvm_open, [ + use_cpu_sup=yes + CPU_SUP_LIBS="$CPU_SUP_LIBS -lkvm" + ]) + case $host_os in solaris2*) os_mon_programs="$os_mon_programs ferrule mod_syslog" ;; + darwin*) + use_cpu_sup=yes ;; + openbsd*) + use_cpu_sup=yes ;; linux*) - os_mon_programs="$os_mon_programs cpu_sup" ;; + use_cpu_sup=yes ;; esac - +if test "$use_cpu_sup" = "yes"; then + os_mon_programs="$os_mon_programs cpu_sup" +fi + AC_ARG_WITH(javac, AS_HELP_STRING([--with-javac=JAVAC], [specify Java compiler to use]) AS_HELP_STRING([--with-javac], [use a Java compiler if found (default)]) @@ -4712,12 +4741,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/Makefile b/erts/doc/src/Makefile index e8b856c3ff..a83aa9b875 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -177,6 +177,8 @@ release_docs_spec: docs $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(HTMLDIR)/* \ "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(ERL_TOP)/erts/example/time_compat.erl \ + "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 16000191dc..ea94a4e82b 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -495,24 +495,35 @@ <c><![CDATA[werl]]></c>, not <c><![CDATA[erl]]></c> (<c><![CDATA[oldshell]]></c>). Note also that <c><![CDATA[Ctrl-Break]]></c> is used instead of <c><![CDATA[Ctrl-C]]></c> on Windows.</p> </item> - <tag><marker id="+c"><c><![CDATA[+c]]></c></marker></tag> - <item> - <p>Disable compensation for sudden changes of system time.</p> - <p>Normally, <c><![CDATA[erlang:now/0]]></c> will not immediately reflect - sudden changes in the system time, in order to keep timers - (including <c><![CDATA[receive-after]]></c>) working. Instead, the time - maintained by <c><![CDATA[erlang:now/0]]></c> is slowly adjusted towards - the new system time. (Slowly means in one percent adjustments; - if the time is off by one minute, the time will be adjusted - in 100 minutes.)</p> - <p>When the <c><![CDATA[+c]]></c> option is given, this slow adjustment - will not take place. Instead <c><![CDATA[erlang:now/0]]></c> will always - reflect the current system time. Note that timers are based - on <c><![CDATA[erlang:now/0]]></c>. If the system time jumps, timers - then time out at the wrong time.</p> - <p><em>NOTE</em>: You can check whether the adjustment is enabled or - disabled by calling - <seealso marker="erlang#system_info_tolerant_timeofday">erlang:system_info(tolerant_timeofday)</seealso>.</p> + <tag><marker id="+c"><c><![CDATA[+c true | false]]></c></marker></tag> + <item> + <p>Enable or disable + <seealso marker="time_correction#Time_Correction">time correction</seealso>:</p> + <taglist> + <tag><c>true</c></tag> + <item><p>Enable time correction. This is the default if + time correction is supported on the specific platform.</p></item> + + <tag><c>false</c></tag> + <item><p>Disable time correction.</p></item> + </taglist> + <p>For backwards compatibility, the boolean value can be omitted. + This is interpreted as <c>+c false</c>. + </p> + </item> + <tag><marker id="+C_"><c><![CDATA[+C no_time_warp | single_time_warp | multi_time_warp]]></c></marker></tag> + <item> + <p>Set + <seealso marker="time_correction#Time_Warp_Modes">time warp mode</seealso>: + </p> + <taglist> + <tag><c>no_time_warp</c></tag> + <item><p><seealso marker="time_correction#No_Time_Warp_Mode">No Time Warp Mode</seealso> (the default)</p></item> + <tag><c>single_time_warp</c></tag> + <item><p><seealso marker="time_correction#Single_Time_Warp_Mode">Single Time Warp Mode</seealso></p></item> + <tag><c>multi_time_warp</c></tag> + <item><p><seealso marker="time_correction#Multi_Time_Warp_Mode">Multi Time Warp Mode</seealso></p></item> + </taglist> </item> <tag><c><![CDATA[+d]]></c></tag> <item> @@ -588,6 +599,11 @@ <p>Sets the default binary virtual heap size of processes to the size <c><![CDATA[Size]]></c>.</p> </item> + <tag><c><![CDATA[+hpds Size]]></c></tag> + <item> + <p>Sets the initial process dictionary size of processes to the size + <c><![CDATA[Size]]></c>.</p> + </item> <tag><c><![CDATA[+K true | false]]></c></tag> <item> <p>Enables or disables the kernel poll functionality if diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 3de94be9ff..4bad8b253c 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -66,34 +66,6 @@ </list> </warning> - <p>The NIF concept is officially supported from R14B. NIF source code - written for earlier experimental versions might need adaption to run on R14B - or later versions:</p> - <list> - <item>No incompatible changes between <em>R14B</em> and R14A.</item> - <item>Incompatible changes between <em>R14A</em> and R13B04: - <list> - <item>Environment argument removed for <c>enif_alloc</c>, - <c>enif_realloc</c>, <c>enif_free</c>, <c>enif_alloc_binary</c>, - <c>enif_realloc_binary</c>, <c>enif_release_binary</c>, - <c>enif_alloc_resource</c>, <c>enif_release_resource</c>, - <c>enif_is_identical</c> and <c>enif_compare</c>.</item> - <item>Character encoding argument added to <c>enif_get_atom</c> - and <c>enif_make_existing_atom</c>.</item> - <item>Module argument added to <c>enif_open_resource_type</c> - while changing name spaces of resource types from global to module local.</item> - </list> - </item> - <item>Incompatible changes between <em>R13B04</em> and R13B03: - <list> - <item>The function prototypes of the NIFs have changed to expect <c>argc</c> and <c>argv</c> - arguments. The arity of a NIF is by that no longer limited to 3.</item> - <item><c>enif_get_data</c> renamed as <c>enif_priv_data</c>.</item> - <item><c>enif_make_string</c> got a third argument for character encoding.</item> - </list> - </item> - </list> - <p>A minimal example of a NIF library can look like this:</p> <p/> <code type="none"> @@ -806,6 +778,12 @@ typedef enum { and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned long</c>.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_has_pending_exception(ErlNifEnv* env)</nametext></name> + <fsummary>Check if an exception has been raised.</fsummary> + <desc><p>Return true if a pending exception is associated + with the environment <c>env</c>. The only possible exception is currently + <c>badarg</c> (see <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>).</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_inspect_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlNifBinary* bin)</nametext></name> <fsummary>Inspect the content of a binary</fsummary> <desc><p>Initialize the structure pointed to by <c>bin</c> with @@ -898,23 +876,37 @@ typedef enum { <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_atom(ErlNifEnv* env, const char* name)</nametext></name> <fsummary>Create an atom term</fsummary> <desc><p>Create an atom term from the null-terminated C-string <c>name</c> - with iso-latin-1 encoding.</p></desc> + with iso-latin-1 encoding. If the length of <c>name</c> exceeds the maximum length + allowed for an atom (255 characters), <c>enif_make_atom</c> invokes + <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>. + </p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_atom_len(ErlNifEnv* env, const char* name, size_t len)</nametext></name> <fsummary>Create an atom term</fsummary> <desc><p>Create an atom term from the string <c>name</c> with length <c>len</c>. - Null-characters are treated as any other characters.</p></desc> + Null-characters are treated as any other characters. If <c>len</c> is greater than the maximum length + allowed for an atom (255 characters), <c>enif_make_atom</c> invokes + <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>. + </p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_badarg(ErlNifEnv* env)</nametext></name> <fsummary>Make a badarg exception.</fsummary> - <desc><p>Make a badarg exception to be returned from a NIF, and set - an associated exception reason in <c>env</c>. If - <c>enif_make_badarg</c> is called, the term it returns <em>must</em> - be returned from the function that called it. No other return value - is allowed. Also, the term returned from <c>enif_make_badarg</c> may - be passed only to - <seealso marker="#enif_is_exception">enif_is_exception</seealso> and - not to any other NIF API function.</p></desc> + <desc><p>Make a badarg exception to be returned from a NIF, and associate + it with the environment <c>env</c>. Once a NIF or any function + it calls invokes <c>enif_make_badarg</c>, the runtime ensures that a + <c>badarg</c> exception is raised when the NIF returns, even if the NIF + attempts to return a non-exception term instead. + The return value from <c>enif_make_badarg</c> may only be used as + return value from the NIF that invoked it (direct or indirectly) + or be passed to + <seealso marker="#enif_is_exception">enif_is_exception</seealso>, but + not to any other NIF API function.</p> + <p>See also: <seealso marker="#enif_has_pending_exception">enif_has_pending_exception</seealso>. + </p> + <note><p>In earlier versions (older than erts-7.0, OTP 18) the return value + from <c>enif_make_badarg</c> had to be returned from the NIF. This + requirement is now lifted as the return value from the NIF is ignored + if <c>enif_make_badarg</c> has been invoked.</p></note></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)</nametext></name> <fsummary>Make a binary term.</fsummary> @@ -931,7 +923,10 @@ typedef enum { </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_double(ErlNifEnv* env, double d)</nametext></name> <fsummary>Create a floating-point term</fsummary> - <desc><p>Create a floating-point term from a <c>double</c>.</p></desc> + <desc><p>Create a floating-point term from a <c>double</c>. If the <c>double</c> argument is + not finite or is NaN, <c>enif_make_double</c> invokes + <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>. + </p></desc> </func> <func><name><ret>int</ret><nametext>enif_make_existing_atom(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding encode)</nametext></name> <fsummary>Create an existing atom term</fsummary> @@ -939,7 +934,9 @@ typedef enum { the null-terminated C-string <c>name</c> with encoding <seealso marker="#ErlNifCharEncoding">encode</seealso>. If the atom already exists store the term in <c>*atom</c> and return true, otherwise - return false.</p></desc> + return false. If the length of <c>name</c> exceeds the maximum length + allowed for an atom (255 characters), <c>enif_make_existing_atom</c> + returns false.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_make_existing_atom_len(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding encoding)</nametext></name> <fsummary>Create an existing atom term</fsummary> @@ -947,7 +944,9 @@ typedef enum { string <c>name</c> with length <c>len</c> and encoding <seealso marker="#ErlNifCharEncoding">encode</seealso>. Null-characters are treated as any other characters. If the atom already exists store the term - in <c>*atom</c> and return true, otherwise return false.</p></desc> + in <c>*atom</c> and return true, otherwise return false. If <c>len</c> is greater + than the maximum length allowed for an atom (255 characters), + <c>enif_make_existing_atom_len</c> returns false.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_int(ErlNifEnv* env, int i)</nametext></name> <fsummary>Create an integer term</fsummary> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 07b5fdd039..ba5f80a9c1 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -58,7 +58,78 @@ </datatype> <datatype> <name name="timestamp"></name> - <desc><p>See <seealso marker="#now/0">now/0</seealso>.</p> + <desc><p>See <seealso marker="#timestamp/0">erlang:timestamp/0</seealso>.</p> + </desc> + </datatype> + <marker id="type_time_unit"/> + <datatype> + <name name="time_unit"></name> + <desc><p>Currently supported time unit representations:</p> + <taglist> + <tag><c>PartsPerSecond :: integer() >= 1</c></tag> + <item><p>Time unit expressed in parts per second. That is, + the time unit equals <c>1/PartsPerSecond</c> second.</p></item> + + <tag><c>seconds</c></tag> + <item><p>Symbolic representation of the time unit + represented by the integer <c>1</c>.</p></item> + + <tag><c>milli_seconds</c></tag> + <item><p>Symbolic representation of the time unit + represented by the integer <c>1000</c>.</p></item> + + <tag><c>micro_seconds</c></tag> + <item><p>Symbolic representation of the time unit + represented by the integer <c>1000000</c>.</p></item> + + <tag><c>nano_seconds</c></tag> + <item><p>Symbolic representation of the time unit + represented by the integer <c>1000000000</c>.</p></item> + + <tag><c>native</c></tag> + <item><p>Symbolic representation of the native time unit + used by the Erlang runtime system.</p> + + <p>The <c>native</c> time unit is determined at + runtime system start, and will remain the same until + the runtime system terminates. If a runtime system + is stopped and then started again (even on the same + machine), the <c>native</c> time unit of the new + runtime system instance may differ from the + <c>native</c> time unit of the old runtime system + instance.</p> + + <p>One can get an approximation of the <c>native</c> + time unit by calling <c>erlang:convert_time_unit(1, + seconds, native)</c>. The result equals the number + of whole <c>native</c> time units per second. In case + the number of <c>native</c> time units per second does + not add up to a whole number, the result will be + rounded downwards.</p> + + <note> + <p>The value of the <c>native</c> time unit gives + you more or less no information at all about the + quality of time values. It sets a limit for + the + <seealso marker="time_correction#Time_Resolution">resolution</seealso> + as well as for the + <seealso marker="time_correction#Time_Precision">precision</seealso> + of time values, + but it gives absolutely no information at all about the + <seealso marker="time_correction#Time_Accuracy">accuracy</seealso> + of time values. The resolution of the <c>native</c> time + unit and the resolution of time values may differ + significantly.</p> + </note> + </item> + + </taglist> + + <p>The <c>time_unit/0</c> type may be extended. Use + <seealso marker="#convert_time_unit/3"><c>erlang:convert_time_unit/3</c></seealso> + in order to convert time values between time units.</p> + </desc> </datatype> </datatypes> @@ -585,6 +656,22 @@ </desc> </func> <func> + <name name="convert_time_unit" arity="3"/> + <fsummary>Convert time unit of a time value</fsummary> + <desc> + <p>Converts the <c><anno>Time</anno></c> value of time unit + <c><anno>FromUnit</anno></c> to the corresponding + <c><anno>ConvertedTime</anno></c> value of time unit + <c><anno>ToUnit</anno></c>. The result is rounded + using the floor function.</p> + + <warning><p>You may lose accuracy and precision when converting + between time units. In order to minimize such loss, collect all + data at <c>native</c> time unit and do the conversion on the end + result.</p></warning> + </desc> + </func> + <func> <name name="crc32" arity="1"/> <fsummary>Compute crc32 (IEEE 802.3) checksum</fsummary> <desc> @@ -1357,7 +1444,7 @@ true <name name="get" arity="1"/> <fsummary>Return a value from the process dictionary</fsummary> <desc> - <p>Returns the value <c><anno>Val</anno></c>associated with <c><anno>Key</anno></c> in + <p>Returns the value <c><anno>Val</anno></c> associated with <c><anno>Key</anno></c> in the process dictionary, or <c>undefined</c> if <c><anno>Key</anno></c> does not exist.</p> <pre> @@ -2205,14 +2292,15 @@ os_prompt% </pre> </func> <func> <name name="make_ref" arity="0"/> - <fsummary>Return an almost unique reference</fsummary> + <fsummary>Return a unique reference</fsummary> <desc> - <p>Returns an almost unique reference.</p> - <p>The returned reference will re-occur after approximately 2^82 - calls; therefore it is unique enough for practical purposes.</p> - <pre> -> <input>make_ref().</input> -#Ref<0.0.0.135></pre> + <p>Return a <seealso marker="doc/efficiency_guide:advanced#unique_references">unique + reference</seealso>. The reference is unique among + connected nodes.</p> + <warning><p>Known issue: When a node is restarted multiple + times with the same node name, references created + on a newer node can be mistaken for a reference + created on an older node with the same node name.</p></warning> </desc> </func> <func> @@ -2513,97 +2601,178 @@ os_prompt% </pre> </desc> </func> <func> - <name name="monitor" arity="2"/> + <name name="monitor" arity="2" clause_i="1"/> + <name name="monitor" arity="2" clause_i="2"/> + <type name="registered_name"/> + <type name="registered_process_identifier"/> + <type name="monitor_process_identifier"/> <fsummary>Start monitoring</fsummary> <desc> - <p>The calling process starts monitoring <c><anno>Item</anno></c> which is - an object of type <c><anno>Type</anno></c>.</p> - <p>Currently only processes can be monitored, i.e. the only - allowed <c><anno>Type</anno></c> is <c>process</c>, but other types may be - allowed in the future.</p> - <p><c><anno>Item</anno></c> can be:</p> - <taglist> - <tag><c>pid()</c></tag> - <item> - <p>The pid of the process to monitor.</p> - </item> - <tag><c>{RegName, Node}</c></tag> - <item> - <p>A tuple consisting of a registered name of a process and - a node name. The process residing on the node <c>Node</c> - with the registered name <c>RegName</c> will be monitored.</p> - </item> - <tag><c>RegName</c></tag> - <item> - <p>The process locally registered as <c>RegName</c> will be - monitored.</p> - </item> - </taglist> - <note> - <p>When a process is monitored by registered name, the process - that has the registered name at the time when - <c>monitor/2</c> is called will be monitored. + <p>Send a monitor request of type <c><anno>Type</anno></c> to the + entity identified by <c><anno>Item</anno></c>. The caller of + <c>monitor/2</c> will later be notified by a monitor message on the + following format if the monitored state is changed:</p> + <code type="none">{Tag, <anno>MonitorRef</anno>, <anno>Type</anno>, Object, Info}</code> + <note><p>The monitor request is an asynchronous signal. That is, it + takes time before the signal reach its destination.</p></note> + <p>Currently valid <c><anno>Type</anno></c>s:</p> + <taglist> + <tag><marker id="monitor_process"/><c>process</c></tag> + <item> + <p>Monitor the existence of the process identified by + <c><anno>Item</anno></c>. Currently valid + <c><anno>Item</anno></c>s in combination with the + <c>process <anno>Type</anno></c>:</p> + <taglist> + <tag><c>pid()</c></tag> + <item> + <p>The process identifier of the process to monitor.</p> + </item> + <tag><c>{RegisteredName, Node}</c></tag> + <item> + <p>A tuple consisting of a registered name of a process and + a node name. The process residing on the node <c>Node</c> + with the registered name <c>{RegisteredName, Node}</c> will + be monitored.</p> + </item> + <tag><c>RegisteredName</c></tag> + <item> + <p>The process locally registered as <c>RegisteredName</c> + will become monitored.</p> + </item> + </taglist> + <note><p>When a process is monitored by registered name, the + process that has the registered name at the time when the + monitor request reach its destination will be monitored. The monitor will not be effected, if the registered name is - unregistered.</p> - </note> - <p>A <c>'DOWN'</c> message will be sent to the monitoring - process if <c><anno>Item</anno></c> dies, if <c><anno>Item</anno></c> does not exist, - or if the connection is lost to the node which <c><anno>Item</anno></c> - resides on. A <c>'DOWN'</c> message has the following pattern:</p> - <code type="none"> -{'DOWN', MonitorRef, Type, Object, Info}</code> - <p>where <c>MonitorRef</c> and <c>Type</c> are the same as - described above, and:</p> - <taglist> - <tag><c>Object</c></tag> - <item> - <p>A reference to the monitored object:</p> - <list type="bulleted"> - <item>the pid of the monitored process, if <c><anno>Item</anno></c> was - specified as a pid.</item> - <item><c>{RegName, Node}</c>, if <c><anno>Item</anno></c> was specified as - <c>{RegName, Node}</c>.</item> - <item><c>{RegName, Node}</c>, if <c><anno>Item</anno></c> was specified as - <c>RegName</c>. <c>Node</c> will in this case be the - name of the local node (<c>node()</c>).</item> - </list> - </item> - <tag><c>Info</c></tag> - <item> - <p>Either the exit reason of the process, <c>noproc</c> - (non-existing process), or <c>noconnection</c> (no - connection to <c><anno>Node</anno></c>).</p> - </item> - </taglist> - <note> - <p>If/when <c>monitor/2</c> is extended (e.g. to - handle other item types than <c>process</c>), other - possible values for <c>Object</c>, and <c>Info</c> in the - <c>'DOWN'</c> message will be introduced.</p> - </note> - <p>The monitoring is turned off either when the <c>'DOWN'</c> - message is sent, or when - <seealso marker="#demonitor/1">demonitor/1</seealso> - is called.</p> - <p>If an attempt is made to monitor a process on an older node - (where remote process monitoring is not implemented or one - where remote process monitoring by registered name is not - implemented), the call fails with <c>badarg</c>.</p> - <p>Making several calls to <c>monitor/2</c> for the same - <c><anno>Item</anno></c> is not an error; it results in as many, completely - independent, monitorings.</p> + unregistered, or unregistered and later registered on another + process.</p></note> + <p>The monitor is triggered either when the monitored process + terminates, is non existing, or if the connection to it is + lost. In the case the connection to it is lost, we do not know + if it still exist or not. After this type of monitor has been + triggered, the monitor is automatically removed.</p> + <p>When the monitor is triggered a <c>'DOWN'</c> message will + be sent to the monitoring process. A <c>'DOWN'</c> message has + the following pattern:</p> + <code type="none">{'DOWN', MonitorRef, Type, Object, Info}</code> + <p>where <c>MonitorRef</c> and <c>Type</c> are the same as + described above, and:</p> + <taglist> + <tag><c>Object</c></tag> + <item> + <p>equals:</p> + <taglist> + <tag><c><anno>Item</anno></c></tag> + <item>If <c><anno>Item</anno></c> was specified by a + pid.</item> + <tag><c>{RegisteredName, Node}</c></tag> + <item>If <c><anno>Item</anno></c> was specified as + <c>RegisteredName</c>, or <c>{RegisteredName, Node}</c> + where <c>Node</c> corresponds to the node that the + monitored process resides on.</item> + </taglist> + </item> + <tag><c>Info</c></tag> + <item> + <p>Either the exit reason of the process, <c>noproc</c> + (non-existing process), or <c>noconnection</c> (no + connection to the node where the monitored process + resides).</p></item> + </taglist> + <p>The monitoring is turned off either when the <c>'DOWN'</c> + message is sent, or when + <seealso marker="#demonitor/1">demonitor/1</seealso> + is called.</p> + <p>If an attempt is made to monitor a process on an older node + (where remote process monitoring is not implemented or one + where remote process monitoring by registered name is not + implemented), the call fails with <c>badarg</c>.</p> + <note> + <p>The format of the <c>'DOWN'</c> message changed in the 5.2 + version of the emulator (OTP release R9B) for monitor + <em>by registered name</em>. The <c>Object</c> element of + the <c>'DOWN'</c> message could in earlier versions + sometimes be the pid of the monitored process and sometimes + be the registered name. Now the <c>Object</c> element is + always a tuple consisting of the registered name and + the node name. Processes on new nodes (emulator version 5.2 + or greater) will always get <c>'DOWN'</c> messages on + the new format even if they are monitoring processes on old + nodes. Processes on old nodes will always get <c>'DOWN'</c> + messages on the old format.</p> + </note> + </item> + <tag><marker id="monitor_time_offset"/><c>time_offset</c></tag> + <item> + <p>Monitor changes in + <seealso marker="#time_offset/0">time offset</seealso> + between + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and + <seealso marker="time_correction#Erlang_System_Time">Erlang + system time</seealso>. There is only one valid + <c><anno>Item</anno></c> in combination with the + <c>time_offset <anno>Type</anno></c>, namely the atom + <c>clock_service</c>. Note that the atom <c>clock_service</c> is + <em>not</em> the registered name of a process. In this specific + case it serves as an identifier of the runtime system internal + clock service at current runtime system instance.</p> + + <p>The monitor is triggered when the time offset is changed. + This either if the time offset value is changed, or if the + offset is changed from preliminary to final during + <seealso marker="#system_flag_time_offset">finalization + of the time offset</seealso> when the + <seealso marker="time_correction#Single_Time_Warp_Mode">single + time warp mode</seealso> is used. When a change from preliminary + to final time offset is made, the monitor will be triggered once + regardless of whether the time offset value was changed due to + the finalization or not.</p> + + <p>If the runtime system is in + <seealso marker="time_correction#Multi_Time_Warp_Mode">multi + time warp mode</seealso>, the time offset will be changed when + the runtime system detects that the + <seealso marker="time_correction#OS_System_Time">OS system + time</seealso> has changed. The runtime system will, however, + not detect this immediately when it happens. A task checking + the time offset is scheduled to execute at least once a minute, + so under normal operation this should be detected within a + minute, but during heavy load it might take longer time.</p> + + <p>The monitor will <em>not</em> be automatically removed + after it has been triggered. That is, repeated changes of + the time offset will trigger the monitor repeatedly.</p> + + <p>When the monitor is triggered a <c>'CHANGE'</c> message will + be sent to the monitoring process. A <c>'CHANGE'</c> message has + the following pattern:</p> + <code type="none">{'CHANGE', MonitorRef, Type, Item, NewTimeOffset}</code> + <p>where <c>MonitorRef</c>, <c><anno>Type</anno></c>, and + <c><anno>Item</anno></c> are the same as described above, and + <c>NewTimeOffset</c> is the new time offset.</p> + + <p>When the <c>'CHANGE'</c> message has been received you are + guaranteed not to retrieve the old time offset when calling + <seealso marker="#time_offset/0"><c>erlang:time_offset()</c></seealso>. + Note that you may observe the change of the time offset + when calling <c>erlang:time_offset()</c> before you + get the <c>'CHANGE'</c> message.</p> + + </item> + </taglist> + <p>Making several calls to <c>monitor/2</c> for the same + <c><anno>Item</anno></c> and/or <c><anno>Type</anno></c> is not + an error; it results in many, completely independent, + monitorings.</p> + <p>The monitor functionality is expected to be extended. That is, + other <c><anno>Type</anno></c>s and <c><anno>Item</anno></c>s + are expected to be supported in the future.</p> <note> - <p>The format of the <c>'DOWN'</c> message changed in the 5.2 - version of the emulator (OTP release R9B) for monitor <em>by registered name</em>. The <c>Object</c> element of - the <c>'DOWN'</c> message could in earlier versions - sometimes be the pid of the monitored process and sometimes - be the registered name. Now the <c>Object</c> element is - always a tuple consisting of the registered name and - the node name. Processes on new nodes (emulator version 5.2 - or greater) will always get <c>'DOWN'</c> messages on - the new format even if they are monitoring processes on old - nodes. Processes on old nodes will always get <c>'DOWN'</c> - messages on the old format.</p> + <p>If/when <c>monitor/2</c> is extended, other + possible values for <c>Tag</c>, <c>Object</c>, and + <c>Info</c> in the monitor message will be introduced.</p> </note> </desc> </func> @@ -2654,6 +2823,51 @@ os_prompt% </pre> </desc> </func> <func> + <name name="monotonic_time" arity="0"/> + <fsummary>Current Erlang monotonic time</fsummary> + <desc> + <p>Returns the current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso>. This + is a monotonically increasing time since some unspecified point in + time.</p> + + <note><p>This is a + <seealso marker="time_correction#Monotonically_Increasing">monotonically increasing</seealso> time, but <em>not</em> a + <seealso marker="time_correction#Strictly_Monotonically_Increasing">strictly monotonically increasing</seealso> + time. That is, consecutive calls to + <c>erlang:monotonic_time/0</c> may produce the same result.</p> + + <p>Different runtime system instances will use different + unspecified points in time as base for their Erlang monotonic clocks. + That is, it is <em>pointless</em> comparing monotonic times from + different runtime system instances. Different runtime system instances + may also place this unspecified point in time different relative + runtime system start. It may be placed in the future (time at start + will be a negative value), the past (time at start will be a + positive value), or the runtime system start (time at start will + be zero). The monotonic time as of runtime system start can be + retrieved by calling + <seealso marker="#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso>.</p></note> + </desc> + </func> + <func> + <name name="monotonic_time" arity="1"/> + <fsummary>Current Erlang monotonic time</fsummary> + <desc> + <p>Returns the current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> converted + into the <c><anno>Unit</anno></c> passed as argument.</p> + + <p>Same as calling + <seealso marker="#convert_time_unit/3"><c>erlang:convert_time_unit</c></seealso><c>(</c><seealso marker="#monotonic_time/0"><c>erlang:monotonic_time()</c></seealso><c>, + native, <anno>Unit</anno>)</c> + however optimized for commonly used <c><anno>Unit</anno></c>s.</p> + </desc> + </func> + <func> <name name="nif_error" arity="1"/> <fsummary>Stop execution with a given reason</fsummary> <desc> @@ -2748,6 +2962,13 @@ os_prompt% </pre> <type name="timestamp"/> <fsummary>Elapsed time since 00:00 GMT</fsummary> <desc> + <warning><p><em>This function is deprecated! Do not use it!</em> + See the users guide chapter + <seealso marker="time_correction">Time and Time Correction</seealso> + for more information. Specifically the + <seealso marker="time_correction#Dos_and_Donts">Dos and Dont's</seealso> + section for information on what to use instead of <c>erlang:now/0</c>. + </p></warning> <p>Returns the tuple <c>{MegaSecs, Secs, MicroSecs}</c> which is the elapsed time since 00:00 GMT, January 1, 1970 (zero hour) on the assumption that the underlying OS supports this. @@ -2760,10 +2981,6 @@ os_prompt% </pre> <p>It can only be used to check the local time of day if the time-zone info of the underlying operating system is properly configured.</p> - <p>If you do not need the return value to be unique and - monotonically increasing, use - <seealso marker="kernel:os#timestamp/0">os:timestamp/0</seealso> - instead to avoid some overhead.</p> </desc> </func> <func> @@ -5510,6 +5727,35 @@ ok <p>Returns the old value of the flag.</p> </desc> </func> + <marker id="system_flag_time_offset"/> + <func> + <name name="system_flag" arity="2" clause_i="12"/> + <fsummary>Finalize the Time Offset</fsummary> + <desc> + <p>Finalizes the <seealso marker="#time_offset/0">time offset</seealso> + when the <seealso marker="time_correction#Single_Time_Warp_Mode">single + time warp mode</seealso> is being used. If another time warp mode than + the "single time warp mode" is used, the time offset state will be left + unchanged.</p> + <p>Returns the old state identifier. That is, if:</p> + <list> + <item><p><c>preliminary</c> is returned, finalization was + performed and the time offset is now final.</p></item> + + <item><p><c>final</c> is returned, the time offset was + already in the final state. This either due to another + <c>erlang:system_flag(time_offset, finalize)</c> call, or + due to the + <seealso marker="time_correction#No_Time_Warp_Mode">no + time warp mode</seealso> being used.</p></item> + + <item><p><c>volatile</c> is returned, the time offset + cannot be finalized due to the + <seealso marker="time_correction#Multi_Time_Warp_Mode">multi + time warp mode</seealso> being used.</p></item> + </list> + </desc> + </func> <func> <name name="system_info" arity="1" clause_i="1"/> <name name="system_info" arity="1" clause_i="2"/> @@ -5790,6 +6036,17 @@ ok <name name="system_info" arity="1" clause_i="53"/> <name name="system_info" arity="1" clause_i="54"/> <name name="system_info" arity="1" clause_i="55"/> + <name name="system_info" arity="1" clause_i="56"/> + <name name="system_info" arity="1" clause_i="57"/> + <name name="system_info" arity="1" clause_i="58"/> + <name name="system_info" arity="1" clause_i="59"/> + <name name="system_info" arity="1" clause_i="60"/> + <name name="system_info" arity="1" clause_i="61"/> + <name name="system_info" arity="1" clause_i="62"/> + <name name="system_info" arity="1" clause_i="63"/> + <name name="system_info" arity="1" clause_i="64"/> + <name name="system_info" arity="1" clause_i="65"/> + <name name="system_info" arity="1" clause_i="66"/> <fsummary>Information about the system</fsummary> <desc> <p>Returns various information about the current system @@ -6177,6 +6434,123 @@ ok documentation of versions in the system principles guide</seealso>.</p> </item> + <tag><marker id="system_info_os_monotonic_time_source"><c>os_monotonic_time_source</c></marker></tag> + <item> + <p>Returns a list containing information about the source of + <seealso marker="erts:time_correction#OS_Monotonic_Time">OS + monotonic time</seealso> that is used by the runtime system.</p> + <p>In case <c>[]</c> is returned, no OS monotonic time is + available. The list contains two-tuples with <c>Key</c>s + as first element, and <c>Value</c>s as second element. The + order if these tuples is undefined. Currently the following + tuples may be part of the list, but more tuples may be + introduced in the future:</p> + <taglist> + <tag><c>{function, Function}</c></tag> + <item><p><c>Function</c> is the name of the funcion + used. This tuple always exist if OS monotonic time is + available to the runtime system.</p></item> + + <tag><c>{clock_id, ClockId}</c></tag> + <item><p>This tuple only exist if <c>Function</c> + can be used with different clocks. <c>ClockId</c> + corresponds to the clock identifer used when calling + <c>Function</c>.</p></item> + + <tag><c>{resolution, OsMonotonicTimeResolution}</c></tag> + <item><p>Highest possible + <seealso marker="time_correction#Time_Resolution">resolution</seealso> + of current OS monotonic time source as parts per + second. If no resolution information can be retreived + from the OS, <c>OsMonotonicTimeResolution</c> will be + set to the resolution of the time unit of + <c>Function</c>s return value. That is, the actual + resolution may be lower than + <c>OsMonotonicTimeResolution</c>. Also note that + the resolution does not say anything about the + <seealso marker="time_correction#Time_Accuracy">accuracy</seealso>, + and that the + <seealso marker="time_correction#Time_Precision">precision</seealso> + might not align with the resolution. You do, + however, know that the precision won't be + better than + <c>OsMonotonicTimeResolution</c>.</p></item> + + <tag><c>{extended, Extended}</c></tag> + <item><p><c>Extended</c> equals <c>yes</c> if + the range of time values has been extended; + otherwise, <c>Extended</c> equals <c>no</c>. The + range needs to be extended if <c>Function</c> + returns values that wrap fast. This typically + is the case when the return value is a 32-bit + value.</p></item> + + <tag><c>{parallel, Parallel}</c></tag> + <item><p><c>Parallel</c> equals <c>yes</c> if + <c>Function</c> is called in parallel from multiple + threads. If it is not called in parallel, because + calls needs to be serialized, <c>Parallel</c> equals + <c>no</c>.</p></item> + + <tag><c>{time, OsMonotonicTime}</c></tag> + <item><p><c>OsMonotonicTime</c> equals current OS + monotonic time in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso>.</p></item> + </taglist> + </item> + <tag><marker id="system_info_os_system_time_source"><c>os_system_time_source</c></marker></tag> + <item> + <p>Returns a list containing information about the source of + <seealso marker="erts:time_correction#OS_System_Time">OS + system time</seealso> that is used by the runtime system.</p> + <p>The list contains two-tuples with <c>Key</c>s + as first element, and <c>Value</c>s as second element. The + order if these tuples is undefined. Currently the following + tuples may be part of the list, but more tuples may be + introduced in the future:</p> + <taglist> + <tag><c>{function, Function}</c></tag> + <item><p><c>Function</c> is the name of the funcion + used.</p></item> + + <tag><c>{clock_id, ClockId}</c></tag> + <item><p>This tuple only exist if <c>Function</c> + can be used with different clocks. <c>ClockId</c> + corresponds to the clock identifer used when calling + <c>Function</c>.</p></item> + + <tag><c>{resolution, OsSystemTimeResolution}</c></tag> + <item><p>Highest possible + <seealso marker="time_correction#Time_Resolution">resolution</seealso> + of current OS system time source as parts per + second. If no resolution information can be retreived + from the OS, <c>OsSystemTimeResolution</c> will be + set to the resolution of the time unit of + <c>Function</c>s return value. That is, the actual + resolution may be lower than + <c>OsSystemTimeResolution</c>. Also note that + the resolution does not say anything about the + <seealso marker="time_correction#Time_Accuracy">accuracy</seealso>, + and that the + <seealso marker="time_correction#Time_Precision">precision</seealso> + might not align with the resolution. You do, + however, know that the precision won't be + better than + <c>OsSystemTimeResolution</c>.</p></item> + + <tag><c>{parallel, Parallel}</c></tag> + <item><p><c>Parallel</c> equals <c>yes</c> if + <c>Function</c> is called in parallel from multiple + threads. If it is not called in parallel, because + calls needs to be serialized, <c>Parallel</c> equals + <c>no</c>.</p></item> + + <tag><c>{time, OsSystemTime}</c></tag> + <item><p><c>OsSystemTime</c> equals current OS + system time in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso>.</p></item> + </taglist> + </item> <tag><marker id="system_info_port_parallelism"><c>port_parallelism</c></marker></tag> <item><p>Returns the default port parallelism scheduling hint used. For more information see the @@ -6302,6 +6676,11 @@ ok <p>Returns <c>true</c> if the emulator has been compiled with smp support; otherwise, <c>false</c>.</p> </item> + <tag><marker id="system_info_start_time"/><c>start_time</c></tag> + <item><p>The <seealso marker="#monotonic_time/0">Erlang monotonic + time</seealso> in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso> at the + time when current Erlang runtime system instance started.</p></item> <tag><c>system_version</c></tag> <item> <p>Returns a string containing version number and @@ -6325,12 +6704,64 @@ ok (<seealso marker="erts:erl_driver#driver_async">driver_async()</seealso>) as an integer.</p> </item> + <tag><marker id="system_info_time_correction"/><c>time_correction</c></tag> + <item><p>Returns a boolean value indicating whether + <seealso marker="time_correction#Time_Correction">time correction</seealso> + is enabled or not. + </p></item> + <tag><marker id="system_info_time_offset"/><c>time_offset</c></tag> + <item><p>Returns the state of the time offset:</p> + <taglist> + <tag><c>preliminary</c></tag> + <item><p>The time offset is preliminary, and will be changed + at a later time when being finalized. The preliminary time offset + is used during the preliminary phase of the + <seealso marker="time_correction#Single_Time_Warp_Mode">single + time warp mode</seealso>.</p></item> + + <tag><c>final</c></tag> + <item><p>The time offset is final. This + either due to the use of the + <seealso marker="time_correction#No_Time_Warp_Mode">no + time warp mode</seealso>, or due to the time offset having + been finalized when using the + <seealso marker="time_correction#Single_Time_Warp_Mode">single + time warp mode</seealso>.</p></item> + + <tag><c>volatile</c></tag> + <item><p>The time offset is volatile. That is, it may + change at any time. This due to the + <seealso marker="time_correction#Multi_Time_Warp_Mode">multi + time warp mode</seealso> being used.</p></item> + </taglist> + </item> + <tag><marker id="system_info_time_warp_mode"/><c>time_warp_mode</c></tag> + <item><p>Returns a value identifying the + <seealso marker="time_correction#Time_Warp_Modes">time warp + mode</seealso> being used:</p> + <taglist> + <tag><c>no_time_warp</c></tag> + <item><p>The <seealso marker="time_correction#No_Time_Warp_Mode">no + time warp mode</seealso> is being used.</p></item> + + <tag><c>single_time_warp</c></tag> + <item><p>The <seealso marker="time_correction#Single_Time_Warp_Mode">single + time warp mode</seealso> is being used.</p></item> + + <tag><c>multi_time_warp</c></tag> + <item><p>The <seealso marker="time_correction#Multi_Time_Warp_Mode">multi + time warp mode</seealso> is being used.</p></item> + </taglist> + </item> <tag><marker id="system_info_tolerant_timeofday"><c>tolerant_timeofday</c></marker></tag> <item> - <p>Returns whether compensation for sudden changes of system - time is <c>enabled</c> or <c>disabled</c>.</p> - <p>See also <seealso marker="erts:erl#+c">+c</seealso> - command line flag.</p> + <p>Returns whether a pre erts-7.0 backwards compatible compensation + for sudden changes of system time is <c>enabled</c> or <c>disabled</c>. + Such compensation is <c>enabled</c> when the + <seealso marker="#system_info_time_offset">time offset</seealso> is + <c>final</c>, and + <seealso marker="#system_info_time_correction">time correction</seealso> + is enabled.</p> </item> <tag><c>trace_control_word</c></tag> <item> @@ -6609,7 +7040,44 @@ ok </note> </desc> </func> + <func> + <name name="system_time" arity="0"/> + <fsummary>Current Erlang system time</fsummary> + <desc> + <p>Returns current + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso>.</p> + + <p>Calling <c>erlang:system_time()</c> is equivalent to: + <seealso marker="#monotonic_time/0"><c>erlang:monotonic_time()</c></seealso><c> + + + </c><seealso marker="#time_offset/0"><c>erlang:time_offset()</c></seealso>.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time + in the general case. For more information, see the documentation of + <seealso marker="time_correction#Time_Warp_Modes">time warp modes</seealso> in the + ERTS User's Guide.</p></note> + </desc> + </func> + <func> + <name name="system_time" arity="1"/> + <fsummary>Current Erlang system time</fsummary> + <desc> + <p>Returns current + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + converted into the <c><anno>Unit</anno></c> passed as argument.</p> + + <p>Calling <c>erlang:system_time(<anno>Unit</anno>)</c> is equivalent to: + <seealso marker="#convert_time_unit/3"><c>erlang:convert_time_unit</c></seealso><c>(</c><seealso marker="#system_time/0"><c>erlang:system_time()</c></seealso><c>, + native, <anno>Unit</anno>)</c>.</p> + <note><p>This time is <em>not</em> a monotonically increasing time + in the general case. For more information, see the documentation of + <seealso marker="time_correction#Time_Warp_Modes">time warp modes</seealso> in the + ERTS User's Guide.</p></note> + </desc> + </func> <func> <name name="term_to_binary" arity="1"/> <fsummary>Encode a term to an Erlang external term format binary</fsummary> @@ -6686,6 +7154,88 @@ ok </desc> </func> <func> + <name name="time_offset" arity="0"/> + <fsummary>Current time offset</fsummary> + <desc> + <p>Returns the current time offset between + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> + and + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> in + <c>native</c> <seealso marker="#type_time_unit">time unit</seealso>. + Current time offset added to an Erlang monotonic time gives + corresponding Erlang system time.</p> + + <p>The time offset may or may not change during operation depending + on the <seealso marker="time_correction#Time_Warp_Modes">time + warp mode</seealso> used.</p> + + <note> + <p>A change in time offset may be observed at slightly + different points in time by different processes.</p> + + <p>If the runtime system is in + <seealso marker="time_correction#Multi_Time_Warp_Mode">multi + time warp mode</seealso>, the time offset will be changed when + the runtime system detects that the + <seealso marker="time_correction#OS_System_Time">OS system + time</seealso> has changed. The runtime system will, however, + not detect this immediately when it happens. A task checking + the time offset is scheduled to execute at least once a minute, + so under normal operation this should be detected within a + minute, but during heavy load it might take longer time.</p> + </note> + </desc> + </func> + <func> + <name name="time_offset" arity="1"/> + <fsummary>Current time offset</fsummary> + <desc> + <p>Returns the current time offset between + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> + and + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + converted into the <c><anno>Unit</anno></c> passed as argument.</p> + + <p>Same as calling + <seealso marker="#convert_time_unit/3"><c>erlang:convert_time_unit</c></seealso><c>(</c><seealso marker="#time_offset/0"><c>erlang:time_offset()</c></seealso><c>, native, <anno>Unit</anno>)</c> + however optimized for commonly used <c><anno>Unit</anno></c>s.</p> + </desc> + </func> + <func> + <name name="timestamp" arity="0"/> + <type name="timestamp"/> + <fsummary>Current Erlang System time</fsummary> + <desc> + <p>Returns current + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + on the format <c>{MegaSecs, Secs, MicroSecs}</c>. This format is + the same that <seealso marker="kernel:os#timestamp/0"><c>os:timestamp/0</c></seealso> + and the now deprecated <seealso marker="#now/0"><c>erlang:now/0</c></seealso> + uses. The reason for the existence of <c>erlang:timestamp()</c> is + purely to simplify usage for existing code that assumes this timestamp + format. Current Erlang system time can more efficiently be retrieved in + the time unit of your choice using + <seealso marker="#system_time/1"><c>erlang:system_time/1</c></seealso>.</p> + + <p>The <c>erlang:timestamp()</c> BIF is equivalent to:</p><code type="none"> +timestamp() -> + ErlangSystemTime = erlang:system_time(micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}.</code> + <p>It however use a native implementation which does + not build garbage on the heap and with slightly better + performance.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time + in the general case. For more information, see the documentation of + <seealso marker="time_correction#Time_Warp_Modes">time warp modes</seealso> in the + ERTS User's Guide.</p></note> + </desc> + + </func> + <func> <name name="tl" arity="1"/> <fsummary>Tail of a list</fsummary> <desc> @@ -7452,6 +8002,100 @@ ok </desc> </func> <func> + <name name="unique_integer" arity="0"/> + <fsummary>Get a unique integer value</fsummary> + <desc> + <p>Generates and returns an + <seealso marker="doc/efficiency_guide:advanced#unique_integers">integer + unique on current runtime system instance</seealso>. The same as calling + <seealso marker="#unique_integer/1"><c>erlang:unique_integer([])</c></seealso>.</p> + </desc> + </func> + <func> + <name name="unique_integer" arity="1"/> + <fsummary>Get a unique integer value</fsummary> + <desc> + <p>Generates and returns an + <seealso marker="doc/efficiency_guide:advanced#unique_integers">integer + unique on current runtime system + instance</seealso>. The integer is unique in the + sense that this BIF, using the same set of + modifiers, will not return the same integer more + than once on the current runtime system instance. + Each integer value can of course be constructed + by other means.</p> + + <p>By default, i.e. when <c>[]</c> is passed as + <c><anno>ModifierList</anno></c>, both negative and + positive integers will be returned. This is order + to be able to utilize the range of integers that do + not need to be heap allocated as much as possible. + By default the returned integers are also only + guaranteed to be unique, i.e., any integer returned + may be either smaller, or larger than previously + returned integers.</p> + + <p>Currently valid <c><anno>Modifier</anno></c>s:</p> + <taglist> + + <tag>positive</tag> + <item><p>Return only positive integers.</p> + <p>Note that by passing the <c>positive</c> modifier + you will get heap allocated integers (big-nums) + quicker.</p> + </item> + + <tag>monotonic</tag> + <item><p>Return + <seealso marker="time_correction#Strictly_Monotonically_Increasing">strictly + monotonically increasing</seealso> integers + corresponding to creation time. That is, the integer + returned will always be larger than previously + returned integers on the current runtime system + instance.</p> + <p>These values can be used when ordering events + on the runtime system instance. That is, if both + <c>X = erlang:unique_integer([monotonic])</c> and + <c>Y = erlang:unique_integer([monotonic])</c> are + executed by different processes (or the same + process) on the same runtime system instance and + <c>X < Y</c> we know that <c>X</c> was created + before <c>Y</c>.</p> + <warning><p>Strictly monotonically increasing values + are inherently quite expensive to generate and scales + poorly. This since the values needs to be + synchronized. That is, do not pass the <c>monotonic</c> + modifier unless you really need strictly monotonically + increasing values.</p></warning> + </item> + + </taglist> + + <p>All currently valid <c><anno>Modifier</anno></c>s + can be combined. Repeated (valid) + <c><anno>Modifier</anno></c>s in the <c>ModifierList</c> + are ignored.</p> + + <note><p>Note that the set of integers returned by + <c>unique_integer/1</c> using diffrent sets of + <c><anno>Modifier</anno></c>s <em>will overlap</em>. + For example, by calling <c>unique_integer([monotonic])</c>, + and <c>unique_integer([positive, monotonic])</c> + repeatedly, you will eventually see some integers being + returned by both calls.</p></note> + + <p>Failures:</p> + <taglist> + <tag><c>badarg</c></tag> + <item>if <c><anno>ModifierList</anno></c> is not a + proper list.</item> + <tag><c>badarg</c></tag> + <item>if <c><anno>Modifier</anno></c> is not a + valid modifier.</item> + </taglist> + </desc> + </func> + <func> <name name="unlink" arity="1"/> <fsummary>Remove a link, if there is one, to another process or port</fsummary> <desc> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index af0d4d7377..35e6e55e72 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,114 @@ </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> + <list> + <item> + <p> + Fix missing quotation in the <c>LM_FIND_EMU_CC</c> + <c>autoconf</c> macro which could cause build failures.</p> + <p> + Own Id: OTP-12388</p> + </item> + <item> + <p> + Fix erroneous printout of monitors in crashdump file.</p> + <p> + Own Id: OTP-12537</p> + </item> + <item> + <p> + The runtime system without SMP support could crash in the + BIF <c>port_control/3</c> if the port that was being + accessed died during the call to the BIF.</p> + <p> + Own Id: OTP-12544 Aux Id: Seq12777 </p> + </item> + <item> + <p> + Avoid corrupt oversized integer to be created from binary + matching. Instead throw system_limit exception which is + the correct behavior. A peculiar symptom of this bug was + that bitwise operations (band, bor, bxor) on such + oversized integers could return the empty list []. + Credit: Mikael Pettersson, Nico Kruber</p> + <p> + Own Id: OTP-12556</p> + </item> + <item> + <p> + A race condition when calling <c>port_info/1</c> could + cause a memory fault has been fixed.</p> + <p> + Own Id: OTP-12587</p> + </item> + <item> + <p> + Fix comparison of exact terms. An overflow that could + cause faulty comparisons has been fixed. Comparison of + exact terms is exclusively used within Maps.</p> + <p> + Own Id: OTP-12623</p> + </item> + <item> + <p> + Fix bug in <c>list_to_integer/1</c> for very long lists + that could cause VM crash.</p> + <p> + Own Id: OTP-12624</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Introduced a runtime system internal 64-bit API for + atomic memory operations.</p> + <p> + Own Id: OTP-12351</p> + </item> + <item> + <p> + Add command line argument option for the initial size of + process dictionaries.</p> + <p> + Use '+hpds <size>' to set initial process + dictionary size for spawned processes.</p> + <p> + Own Id: OTP-12535 Aux Id: seq12809 </p> + </item> + <item> + <p> + Fix documentation on $char for Unicode</p> + <p> + Own Id: OTP-12545</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 6.3.1</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 7f7c28fc30..8af98acc19 100644 --- a/erts/doc/src/time_correction.xml +++ b/erts/doc/src/time_correction.xml @@ -21,8 +21,8 @@ </legalnotice> - <title>Time and time correction in Erlang</title> - <prepared>Patrik Nyblom</prepared> + <title>Time and Time Correction in Erlang</title> + <prepared></prepared> <responsible></responsible> <docno></docno> <approved></approved> @@ -31,6 +31,209 @@ <rev>PA1</rev> <file>time_correction.xml</file> </header> + + <section> + <title>New Extended Time Functionality</title> + <note><p>As of OTP 18 (ERTS version 7.0) the time functionality of + Erlang has been extended. This both includes a + <seealso marker="#The_New_Time_API">new API</seealso> + for time, as well as + <seealso marker="#Time_Warp_Modes">time warp + modes</seealso> which alters the behavior of the system when + system time changes.</p> + <p>The <seealso marker="#No_Time_Warp_Mode">default + time warp mode</seealso> has the same behavior as before, and the + old API will still work, so you are not required to change + anything unless you want to. However, <em>you are strongly + encouraged to use the new API</em> instead of the old API based + on <seealso marker="erlang#now/0"><c>erlang:now/0</c></seealso>. + <c>erlang:now/0</c> has been deprecated since it is and forever + will be a scalability bottleneck. By using the new API you will + automatically get scalability and performance improvements. This + will also enable you to use the + <seealso marker="#Multi_Time_Warp_Mode">multi time warp mode</seealso> + which improves accuracy, and precision of time measurements.</p></note> + </section> + + <section> + <title>Some Terminology</title> + <p>In order to make it easier to understand this document we first + define some terminology. This is a mixture of our own terminology + (Erlang/OS system time, Erlang/OS monotonic time, time warp) + and globally accepted terminology.</p> + + <marker id="Monotonically_Increasing"/> + <section> + <title>Monotonically Increasing</title> + <p>In a monotonically increasing sequence of values, all values + that have a predecessor are either larger than, or equal to its + predecessor.</p> + </section> + + <marker id="Strictly_Monotonically_Increasing"/> + <section> + <title>Strictly Monotonically Increasing</title> + <p>In a strictly monotonically increasing sequence of values, + all values that have a predecessor are larger than its + predecessor.</p> + </section> + + <marker id="UT1"/> + <section> + <title>UT1</title> + <p>Universal Time. Based on the rotation of the earth. Conceptually + mean solar time at 0° longitude.</p> + </section> + + <marker id="UTC"/> + <section> + <title>UTC</title> + <p>Coordinated Universal Time. UTC almost align with + <seealso marker="#UT1">UT1</seealso>, however, UTC uses the + SI definition of a second which is not exactly of the same length + as the second used by UT1. This means that UTC slowly drifts from + UT1. In order to keep UTC relatively in sync with UT1, leap seconds + are inserted, and potentially also deleted. That is, an UTC day may + be 86400, 86401, or 86399 seconds long.</p> + </section> + + <marker id="POSIX_Time"/> + <section> + <title>POSIX Time</title> + <p>Time since + <url href="http://pubs.opengroup.org/onlinepubs/9699919799/xrat/V4_xbd_chap03.html#tag_21_03_00_17">Epoch</url>. + Epoch is defined to be 00:00:00 <seealso marker="#UTC">UTC</seealso>, + January 1, 1970. + <url href="http://pubs.opengroup.org/onlinepubs/009604499/basedefs/xbd_chap04.html#tag_04_14">A day in POSIX time</url> + is defined to be exactly 86400 seconds long. Strangely enough + Epoch is defined to be a time in UTC, and UTC have another + definition of how long a day is. Quoting the Open Group + <url href="http://pubs.opengroup.org/onlinepubs/9699919799/xrat/V4_xbd_chap04.html#tag_21_04_15">"POSIX time is therefore not necessarily UTC, despite its appearance"</url>. The effect of this is that when an UTC leap second is + inserted, POSIX time either stops for a second, or repeats the + last second. If an UTC leap second would be deleted (has never + happened yet), POSIX time would make a one second leap forward.</p> + </section> + + <marker id="Time_Resolution"/> + <section> + <title>Time Resolution</title> + <p>The shortest time interval that can be distinguished when + reading time values.</p> + </section> + + <marker id="Time_Precision"/> + <section> + <title>Time Precision</title> + <p>The shortest time interval that can be be distinguished + repeatedly and reliably when reading time values. Precision + is limited by the + <seealso marker="#Time_Resolution">resolution</seealso>, but + resolution and precision might differ significantly.</p> + </section> + + <marker id="Time_Accuracy"/> + <section> + <title>Time Accuracy</title> + <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> + <p>The operating systems view of + <seealso marker="#POSIX_Time">POSIX time</seealso>. It can be + retrieved by calling + <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, <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> + </section> + + <marker id="OS_Monotonic_Time"/> + <section> + <title>OS Monotonic Time</title> + <p>A monotonically increasing time provided by the operating + 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 + <seealso marker="erlang#system_info_os_monotonic_time_source"><c>erlang:system_info(os_monotonic_time_source)</c></seealso>.</p> + </section> + + <marker id="Erlang_System_Time"/> + <section> + <title>Erlang System Time</title> + <p>The Erlang runtime systems view of + <seealso marker="#POSIX_Time">POSIX time</seealso>. It can be + retrieved by calling + <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 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"/> + <section> + <title>Erlang Monotonic Time</title> + <p>A monotonically increasing time provided by the + Erlang runtime system. The Erlang monotonic time increase since + some unspecified point in time. It can be retrieved by calling + <seealso marker="erlang#monotonic_time/0"><c>erlang:monotonic_time()</c></seealso>. + The + <seealso marker="#Time_Accuracy">accuracy</seealso>, and + <seealso marker="#Time_Precision">precision</seealso> of Erlang + monotonic time heavily depends on the accuracy and precision of + <seealso marker="#OS_Monotonic_Time">OS monotonic time</seealso>, + the accuracy and precision of + <seealso marker="#OS_System_Time">OS system time</seealso> as well + as on the + <seealso marker="#Time_Warp_Modes">time warp mode</seealso> + used. On a system that is lacking OS monotonic time, the Erlang + monotonic time can only guarantee monotonicity and can more or less + not give any other guarantees. The frequency adjustments made to + the Erlang monotonic time depends on the time warp mode + used.</p> + + <p>Internally in the runtime system the Erlang monotonic + time is the "time engine" that is used for more or less + everything that has anything to do with time. All timers + regardless of it is a <c>receive ... after</c> timer, BIF timer, + or a timer in the <c>timer</c> module are triggered + relative Erlang monotonic time. Even + <seealso marker="#Erlang_System_Time">Erlang system + time</seealso> is based on Erlang monotonic time. + By adding current Erlang monotonic time with current time + offset you get current Erlang system time. Current time + offset can be retrieved by calling + <seealso marker="erlang#time_offset/0"><c>erlang:time_offset/0</c></seealso>. + </p> + </section> + + </section> + + <section> + <title>Introduction</title> + <p>Time is vital to an Erlang program and, more importantly, <em>correct</em> time is vital to an Erlang program. As Erlang is a language with soft real time properties and we have the possibility to express @@ -83,192 +286,592 @@ microsecond resolution or much less, but generally it has a drift that is not to be ignored.</p> - <p>So we have this monotonic ticking and we have the wall clock - time. Two unreliable times that together can give us an estimate of - an actual wall clock time that does not jump around and that - monotonically moves forward. If the tick counter has a high - resolution, this is fairly easy to do, if the counter has a low - resolution, it's more expensive, but still doable down to - frequencies of 50-60 Hz (of the tick counter).</p> - - <p>So the corrected time is the nearest approximation of an atomic - clock that is available on the computer. We want it to have the - following properties:</p> - <taglist> - <tag>Monotonic</tag> - <item>The clock should not move backwards</item> - <tag>Intervals should be near the truth</tag> - <item>We want the actual time (as measured by an atomic clock or - an astronomer) that passes between two time stamps, T1 and T2, to be as - near to T2 - T1 as possible.</item> - <tag>Tight coupling to the wall clock</tag> - <item>We want a timer that is to be fired when the wall clock - reaches a time in the future, to fire as near to that point in - time as possible</item> - </taglist> - <p>To meet all the criteria, we have to utilize both times in such a - way that Erlangs "corrected time" moves slightly slower or slightly - faster than the wall clock to get in sync with it. The word - "slightly" means a maximum of 1% difference to the wall clock time, - meaning that a sudden change in the wall clock of one minute, takes - 100 minutes to fix, by letting all "corrected time" move 1% slower - or faster.</p> - - <p>Needless to say, correcting for a faulty handling of daylight - saving time may be disturbing to a user comparing wall clock - time to for example calendar:now_to_local_time(erlang:now()). But - calendar:now_to_local_time/1 is not supposed to be used for presenting wall - clock time to the user.</p> - - <p>Time correction is not perfect, but it saves you from the havoc - of clocks jumping around, which would make timers in your program - fire far to late or far to early and could bring your whole system - to it's knees (or worse) just because someone detected a small error - in the wall clock time of the server where your program runs. So - while it might be confusing, it is still a really good feature of - Erlang and you should not throw it away using time functions which - may give you higher benchmark results, not unless you really know - what you're doing.</p> + </section> + <marker id="Time_Correction"/> <section> - <title>What does time correction mean in my system?</title> - <p>Time correction means that Erlang estimates a time from current - and previous settings of the wall clock, and it uses a fairly - exact tick counter to detect when the wall clock time has jumped - for some reason, slowly adjusting to the new value.</p> - - <p>In practice, this means that the difference between two calls - to time corrected functions, like erlang:now(), might differ up to - one percent from the corresponding calls to non time corrected - functions (like os:timestamp()). Furthermore, if comparing - calendar:local_time/0 to calendar:now_to_local_time(erlang:now()), - you might temporarily see a difference, depending on how well kept your - system is.</p> - - <p>It is important to understand that it is (to the program) - always unknown if it is the wall clock time that moves in the - wrong pace or the Erlang corrected time. The only way to determine - that, is to have an external source of universally correct time. If - some such source is available, the wall clock time can be kept - nearly perfect at all times, and no significant difference will be - detected between erlang:now/0's pace and the wall clock's.</p> - - <p>Still, the time correction will mean that your system keeps - it's real time characteristics very well, even when the wall clock - is unreliable.</p> + <title>Time Correction</title> + <p>If time correction is enabled, the Erlang runtime system + will make use of both + <seealso marker="#OS_System_Time">OS system time</seealso> + and <seealso marker="#OS_Monotonic_Time">OS monotonic time</seealso>, + in order to make adjustments of the frequency of the Erlang + monotonic clock. Time correction will ensure that + <seealso marker="#Erlang_Monotonic_Time">Erlang monotonic time</seealso> + will not warp, and that the frequency is relatively accurate. + The type of adjustments made to the frequency depends on the + time warp mode used. This will be discussed in more details in + the <seealso marker="#Time_Warp_Modes">time warp modes</seealso> + section below.</p> + + <p>By default time correction will be enabled if support for + it on the specific platform exist. Support for it includes + both an OS monotonic time provided by the OS, and an + implementation in the Erlang runtime system utilizing the + OS monotonic time. You can check if your system has support + for OS monotonic time by calling + <seealso marker="erlang#system_info_os_monotonic_time_source"><c>erlang:system_info(os_monotonic_time_source)</c></seealso>, + and you can check if time correction is enabled on your + system by calling + <seealso marker="erlang#system_info_time_correction"><c>erlang:system_info(time_correction)</c></seealso>.</p> + + <p>Time correction is enabled or disabled by passing the + <seealso marker="erl#+c"><c>+c [true|false]</c></seealso> + command line argument to <c>erl</c>.</p> + + <p>If time correction is disabled, Erlang monotonic time + may warp forwards, it may stop and even freeze for extended + periods of time, and there are no guarantees that the frequency + of the Erlang monotonic clock is accurate or stable.</p> + + <p><em>You typically never want to disable time correction</em>. + Previously there was a performance penalty associated with time + correction, but nowadays it is most often the other way around. + By disabling time correction you are likely to get bad scalability, + bad performance, and bad time measurements.</p> </section> + + + <marker id="Time_Warp_Safe_Code"/> <section> - <title>Where does Erlang use corrected time?</title> - <p>For all functionality where real time characteristics are - desirable, time correction is used. This basically means:</p> - <taglist> - <tag>erlang:now/0</tag> - <item>The infamous erlang:now/0 function uses time correction so - that differences between two "now-timestamps" will correspond to - other timeouts in the system. erlang:now/0 also holds other - properties, discussed later.</item> - <tag>receive ... after</tag> - <item>Timeouts on receive uses time correction to determine a - stable timeout interval.</item> - <tag>The timer module</tag> - <item>As the timer module uses other built in functions which - deliver corrected time, the timer module itself works with - corrected time.</item> - <tag>erlang:start_timer/3 and erlang:send_after/3</tag> - <item>The timer BIF's work with corrected time, so that they - will not fire prematurely or too late due to changes in the wall - clock time.</item> - </taglist> - - <p>All other functionality in the system where erlang:now/0 or any - other time corrected functionality is used, will of course - automatically benefit from it, as long as it's not "optimized" to - use some other time stamp function (like os:timestamp/0).</p> - - <p>Modules like calendar and functions like erlang:localtime/0 use - the wall clock time as it is currently set on the system. They - will not use corrected time. However, if you use a now-value and - convert it to local time, you will get a corrected local time - value, which may or may not be what you want. Typically older code - tend to use erlang:now/0 as a wall clock time, which is usually - correct (at least when testing), but might surprise you when - compared to other times in the system.</p> + <title>Time Warp Safe Code</title> + <p>Time warp safe code is code that is able to handle + a <seealso marker="#Time_Warp">time warp</seealso> of + <seealso marker="#Erlang_System_Time">Erlang system time</seealso>. + </p> + + <p><seealso marker="erlang#now/0"><c>erlang:now/0</c></seealso> + behaves very bad when Erlang system time warps. When Erlang + system time do a time warp backwards, the values returned + from <c>erlang:now/0</c> will freeze (if you disregard the + micro second increments made due to the actual call) until + OS system time reach the point of the last value returned by + <c>erlang:now/0</c>. This freeze might continue for very + long periods of time. It might take years, decades, + and even longer than this until the freeze stops.</p> + + <p>All uses of <c>erlang:now/0</c> are not necessarily + time warp unsafe. If you do not use it to get time, it + will be time warp safe. However <em>all uses of + <c>erlang:now/0</c> are suboptimal</em> from a performance + and scalability perspective. So you really want to replace + the usage of it with other functionality. For examples + of how to replace the usage of <c>erlang:now/0</c>, + see the <seealso marker="#Dos_and_Donts">Dos and Donts</seealso> + section.</p> </section> + + <marker id="Time_Warp_Modes"/> <section> - <title>What is erlang:now/0 really?</title> - <p>erlang:now/0 is a function designed to serve multiple purposes - (or a multi-headed beast if you're a VM designer). It is expected - to hold the following properties:</p> - <taglist> - <tag>Monotonic</tag> - <item>erlang:now() never jumps backwards - it always moves - forward</item> - <tag>Interval correct</tag> - <item>The interval between two erlang:now() calls is expected to - correspond to the correct time in real life (as defined by an - atomic clock, or better)</item> - <tag>Absolute correctness</tag> - <item>The erlang:now/0 value should be possible to convert to an - absolute and correct date-time, corresponding to the real world - date and time (the wall clock)</item> - <tag>System correspondence</tag> - <item>The erlang:now/0 value converted to a date-time is - expected to correspond to times given by other programs on the - system (or by functions like os:timestamp/0)</item> - <tag>Unique</tag> - <item>No two calls to erlang:now on one Erlang node should - return the same value</item> - </taglist> - <p>All these requirements are possible to uphold at the same - time if (and only if):</p> - <taglist> - <tag>The wall clock time of the system is perfect</tag> - <item>The system (Operating System) time needs to be perfectly - in sync with the actual time as defined by an atomic clock or - a better time source. A good installation using NTP, and that is - up to date before Erlang starts, will have properties that for - most users and programs will be near indistinguishable from the - perfect time. Note that any larger corrections to the time done - by hand, or after Erlang has started, will partly (or - temporarily) invalidate some of the properties, as the time is - no longer perfect.</item> - <tag>Less than one call per microsecond to erlang:now/0 is - done</tag> - <item>This means that at <em>any</em> microsecond interval in - time, there can be no more than one call to erlang:now/0 in the - system. However, for the system not to loose it's properties - completely, it's enough that it on average is no more than one - call per microsecond (in one Erlang node).</item> - </taglist> - <p>The uniqueness property of erlang:now/0 is the most limiting - property. It means that erlang:now() maintains a global state and - that there is a hard-to-check property of the system that needs to - be maintained. For most applications this is still not a problem, - but a future system might very well manage to violate the - frequency limit on the calls globally. The uniqueness property is - also quite useless, as there are globally unique references that - provide a much better unique value to programs. However the - property will need to be maintained unless a really subtle - backward compatibility issue is to be introduced.</p> + <title>Time Warp Modes</title> + + <p>Current <seealso marker="#Erlang_System_Time">Erlang system + time</seealso> is determined by adding current + <seealso marker="erlang#monotonic_time/0">Erlang monotonic time</seealso> + with current + <seealso marker="erlang#time_offset/0">time offset</seealso>. The + time offset is managed differently depending on which time + warp mode you use. The time warp mode is set by passing the + <seealso marker="erl#+C_"><c>+C + [no_time_warp|single_time_warp|multi_time_warp]</c></seealso> + command line argument to <c>erl</c>.</p> + + <marker id="No_Time_Warp_Mode"/> + <section> + <title>No Time Warp Mode</title> + <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 <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 + monotonic clock in order to smoothly align Erlang system + time with OS system time. A big downside of this approach + is that we on purpose will use a faulty frequency on the + Erlang monotonic clock if adjustments are needed. This + error may be as big as 1%. This error will show up in all + time measurements in the runtime system.</p> + + <p>If time correction is not enabled, the Erlang monotonic + time will freeze when the OS system time leap backwards. + The freeze of the monotonic time will continue until + OS system time catch up. The freeze may continue for + a very long time. When OS system time leaps forwards, + Erlang monotonic time will also leap forward.</p> + </section> + + <marker id="Single_Time_Warp_Mode"/> + <section> + <title>Single Time Warp Mode</title> + <p>This mode is more or less a backwards compatibility mode + as of its introduction.</p> + <p>On an embedded system it is not uncommon that the system + has no power supply at all, not even a battery, when it is + shut off. The system clock on such a system will typically + be way off when the system boots. If the + <seealso marker="#No_Time_Warp_Mode">no time warp mode</seealso> + is used, and the Erlang runtime system is started before + the OS system time has been corrected, the Erlang system + time may be wrong for a very long time, even centuries or + more.</p> + <p>If you for some reason need to use Erlang code that + is not + <seealso marker="#Time_Warp_Safe_Code">time warp safe</seealso>, + and you need to start the Erlang runtime system before the OS + 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 <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 + handled in two phases:</p> + + <taglist> + <tag>Preliminary Phase</tag> + <item> + <p>The preliminary phase starts when the runtime + system starts. A preliminary time offset based on + 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, 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 + when the <seealso marker="#No_Time_Warp_Mode">no time warp + mode</seealso> is used.</p> + </item> + + <tag>Final Phase</tag> + <item> + + <p>The final phase begin when the user finalize the time + offset by calling + <seealso marker="erlang#system_flag_time_offset"><c>erlang:system_flag(time_offset, finalize)</c></seealso>. + The finalization can only be performed once. + </p> + + <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 + 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> + + <p>In order for this to work properly there are two + requirements that the user needs to ensure are + satisfied:</p> + + <taglist> + <tag>Forward Time Warp</tag> + <item><p>The time warp made when finalizing the time offset + can only be done forwards without encountering problems. + This implies that the user has to ensure that the OS + system time is set to a time earlier or equal to actual + POSIX time before starting the Erlang runtime system. If + you are not completely sure the OS system time is correct, + set it to a time that is guaranteed to be earlier than + actual POSIX time before starting the Erlang runtime + system just to be safe.</p></item> + + <tag>Finalize Correct OS System Time</tag> + <item><p>The OS system time needs to be correct when the + the user finalizes the time offset.</p></item> + </taglist> + + <p>If these requirements are not fulfilled, the system + may behave very bad. + </p> + + <p>Assuming that the requirements above are fulfilled, + time correction is enabled, and that the OS system time + is adjusted using some time adjustment protocol like NTP + or similar, only small adjustments of the Erlang monotonic + time should be needed in order to keep system times + aligned after finilization. As long as the system is not + suspended, the largest adjustments needed should be for + inserted (or deleted) leap seconds.</p> + + <warning><p>In order to be able to use this mode you have + to ensure that all Erlang code that will execute in + both phases are + <seealso marker="#Time_Warp_Safe_Code">time warp + safe</seealso>.</p> + <p>Code that only execute in the final phase does not have + to be able to cope with the time warp.</p></warning> + + </section> + + <marker id="Multi_Time_Warp_Mode"/> + <section> + <title>Multi Time Warp Mode</title> + + <p><em>Multi time warp mode in combination with time + correction is the preferred configuration</em>. This since, + on almost all platforms, the Erlang runtime system will have + better performance, will scale better, will behave better, + and since the accuracy, and precision of time measurements + will be better. Only Erlang runtime systems executing on + ancient platforms will benefit from another configuration.</p> + + <p>The time offset may change at any time without limitations. + That is, Erlang system time may perform time warps both + forwards and backwards at <em>any</em> time. Since we align + the Erlang system time with the OS system time by changing + the time offset, we can enable a time correction that tries + to adjust the frequency of the Erlang monotonic clock to be as + correct as possible. This will make time measurements using + the Erlang monotonic time more accurate and precise.</p> + + <p>If time correction is disabled, Erlang monotonic time + will leap forward if OS system time leaps forward. If the + OS system time leaps backwards, Erlang monotonic time will + stop briefly but it does not freeze for extended periods + of time. This since the time offset is changed in order to + align Erlang system time with OS system time.</p> + + <warning><p>In order to be able to use this mode you have + to ensure that all Erlang code that will execute on the + runtime system is + <seealso marker="#Time_Warp_Safe_Code">time warp + safe</seealso>.</p></warning> + </section> </section> + + <marker id="The_New_Time_API"/> <section> - <title>Should I use erlang:now/0 or os:timestamp/0</title> - <p>The simple answer is to use erlang:now/0 for everything where - you want to keep real time characteristics, but use os:timestamp - for things like logs, user communication and debugging (typically - timer:ts uses os:timestamp, as it is a test tool, not a real world - application API). The benefit of using os:timestamp/0 is that it's - faster and does not involve any global state (unless the operating - system has one). The downside is that it will be vulnerable to wall - clock time changes.</p> + <title>The New Time API</title> + + <p>The old time API is based on + <seealso marker="erlang#now/0"><c>erlang:now/0</c></seealso>. + The major issue with <c>erlang:now/0</c> is that it was + intended to be used for so many unrelated things. This + tied these unrelated operations together and unnecessarily + caused performance, scalability as well as accuracy, and + precision issues for operations that do not need to have + such issues. The new API spreads different functionality + over multiple functions in order to improve on this.</p> + + <p>In order to be backwards compatible <c>erlang:now/0</c> will + remain as is, but <em>you are strongly discouraged from using + it</em>. A lot of uses of <c>erlang:now/0</c> will also + prevent you from using the new + <seealso marker="#Multi_Time_Warp_Mode">multi time warp + mode</seealso> which is an important part of this + new time functionality improvement.</p> + + <p>Some of the new BIFs on some systems, perhaps surprisingly, + return negative integer values on a newly started run time + system. This is not a bug, but a memory usage optimization.</p> + + <p>The new API consists of a number of new BIFs:</p> + <list> + <item><p><seealso marker="erlang#convert_time_unit/3"><c>erlang:convert_time_unit/3</c></seealso></p></item> + <item><p><seealso marker="erlang#monotonic_time/0"><c>erlang:monotonic_time/0</c></seealso></p></item> + <item><p><seealso marker="erlang#monotonic_time/1"><c>erlang:monotonic_time/1</c></seealso></p></item> + <item><p><seealso marker="erlang#system_time/0"><c>erlang:system_time/0</c></seealso></p></item> + <item><p><seealso marker="erlang#system_time/1"><c>erlang:system_time/1</c></seealso></p></item> + <item><p><seealso marker="erlang#time_offset/0"><c>erlang:time_offset/0</c></seealso></p></item> + <item><p><seealso marker="erlang#time_offset/1"><c>erlang:time_offset/1</c></seealso></p></item> + <item><p><seealso marker="erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso></p></item> + <item><p><seealso marker="erlang#unique_integer/0"><c>erlang:unique_integer/0</c></seealso></p></item> + <item><p><seealso marker="erlang#unique_integer/1"><c>erlang:unique_integer/1</c></seealso></p></item> + <item><p><seealso marker="kernel:os#system_time/0"><c>os:system_time/0</c></seealso></p></item> + <item><p><seealso marker="kernel:os#system_time/1"><c>os:system_time/1</c></seealso></p></item> + </list> + <p>and a number of extensions of existing BIFs:</p> + <list> + <item><p><seealso marker="erlang#monitor/2"><c>erlang:monitor(time_offset, clock_service)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_flag_time_offset"><c>erlang:system_flag(time_offset, finalize)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_os_monotonic_time_source"><c>erlang:system_info(os_monotonic_time_source)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_os_system_time_source"><c>erlang:system_info(os_system_time_source)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_time_offset"><c>erlang:system_info(time_offset)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_time_warp_mode"><c>erlang:system_info(time_warp_mode)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_time_correction"><c>erlang:system_info(time_correction)</c></seealso></p></item> + <item><p><seealso marker="erlang#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso></p></item> + </list> + + <marker id="The_New_Erlang_Monotonic_Time"/> + <section> + <title>The New Erlang Monotonic Time</title> + <p>The Erlang monotonic time as such is new as of ERTS + version 7.0. It has been introduced in order to be able + to detach time measurements such as elapsed time from + calender time. It is very common that one is interested + in measuring elapsed time or specifying a time relative + to another point in time without having any need to know + what the involved times are in UTC or any other + globally defined time scale. By introducing a time scale + that has a local definition of where it starts, it is + possible to manage time that do not concern calender + time on that time scale. Erlang monotonic time use + such a time scale with a locally defined start.</p> + + <p>The introduction of Erlang monotonic time gives us + the possibility to adjust the two Erlang times (Erlang + monotonic time and Erlang system time) separately. By + doing this, accuracy of elapsed time does not have to + suffer just because the system time happened to be + wrong at some point in time. Separate adjustments + of the two times are only performed in the time warp + modes, and only fully separated in the + <seealso marker="#Multi_Time_Warp_Mode">multi + time warp mode</seealso>. All other modes than the + multi time warp mode are there for backwards + compatibility reasons, and when using these the + accuracy of Erlang monotonic time suffer since + the adjustments of Erlang monotonic time in these + modes are more or less tied to the Erlang system + time.</p> + + <p>The adjustment of system time could have been made + smother than using a time warp approach, but we think + that would be a bad choice. Since we are able to + express and measure time that aren't connected to + calender time by the use of Erlang monotonic time, it + is better to expose the change in Erlang system time + immediately. This since it makes it possible for the + Erlang applications executing on the system to react + on the change in system time as soon as possible. This + is also more or less exactly how most OSes handle this + (OS monotonic time and OS system time). By adjusting + system time smoothly we would just hide the fact that + system time changed and make it harder for the Erlang + applications to react to the change in a sensible way.</p> + + <p>In order to be able to react to a change in Erlang + system time you have to be able to detect that it + happened. The change in Erlang system time occurs when + current time offset is changed. We have therefore + introduced the possibility to monitor the time offset + using + <seealso marker="erlang#monitor/2"><c>erlang:monitor(time_offset, clock_service)</c></seealso>. A process monitoring the time + offset will be sent a message on the following format + when the time offset is changed:</p> + <code type="none">{'CHANGE', MonitorReference, time_offset, clock_service, NewTimeOffset}</code> + </section> + + <marker id="Unique_Values"/> + <section> + <title>Unique Values</title> + <p>Besides reporting time <c>erlang:now/0</c> also + produce unique and strictly monotonically increasing + values. In order to detach this functionality from + time measurements we have introduced + <seealso marker="erlang#unique_integer/1"><c>erlang:unique_integer()</c></seealso>. + </p> + </section> + + <marker id="Dos_and_Donts"/> + <section> + <title>Dos and Don'ts</title> + <p>Previously <c>erlang:now/0</c> was the only option for doing + quite a lot of things. We will look at a few different things + <c>erlang:now/0</c> could be used for, and how you want to do + this using the new API:</p> + + <marker id="Dos_and_Donts_Retrieve_Erlang_System_Time"/> + <section> + <title>Retrieve Erlang System Time</title> + <dont> + <p> + use <c>erlang:now/0</c> in order to retrieve current Erlang + system time. + </p> + </dont> + <do> + <p> + use + <seealso marker="erlang#system_time/1"><c>erlang:system_time/1</c></seealso> + in order to retrieve current Erlang system time on the + <seealso marker="erlang#type_time_unit">time unit</seealso> + of your choice.</p> + <p>If you want the same format as returned by <c>erlang:now/0</c>, use + <seealso marker="erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>. + </p> + </do> + </section> + + <marker id="Dos_and_Donts_Measure_Elapsed_Time"/> + <section> + <title>Measure Elapsed Time</title> + <dont> + <p> + take timestamps with <c>erlang:now/0</c> and calculate + the difference in time with + <seealso marker="stdlib:timer#now_diff/2"><c>timer:now_diff/2</c></seealso>. + </p> + </dont> + <do> + <p> + take timestamps with + <seealso marker="erlang#monotonic_time/0"><c>erlang:monotonic_time/0</c></seealso> + and calculate the time difference using ordinary subtraction. + The result will be in <c>native</c> + <seealso marker="erlang#type_time_unit">time unit</seealso>. + If you want to convert the + result to another time unit you can do this using + <seealso marker="erlang#convert_time_unit/3"><c>erlang:convert_time_unit/3</c></seealso>. + </p> + <p>Another easier way of doing this is to use + <seealso marker="erlang#monotonic_time/1"><c>erlang:monotonic_time/1</c></seealso> + with desired time unit. However, you may lose accuracy, + and precision this way. + </p> + </do> + </section> + + <marker id="Dos_and_Donts_Determine_Order_of_Events"/> + <section> + <title>Determine Order of Events</title> + <dont> + <p> + determine the order of events by saving a timestamp + with <c>erlang:now/0</c> when the event happens. + </p> + </dont> + <do> + <p> + determine the order of events by saving the integer + returned by + <seealso marker="erlang#unique_integer/1"><c>erlang:unique_integer([monotonic])</c></seealso> + when the event happens. These integers will be strictly + monotonically ordered on current runtime system instance + corresponding to creation time. + </p> + </do> + </section> + + <marker id="Dos_and_Donts_Determine_Order_of_Events_With_Time_of_the_Event"/> + <section> + <title>Determine Order of Events With Time of the Event</title> + <dont> + <p> + determine the order of events by saving a timestamp + with <c>erlang:now/0</c> when the event happens. + </p> + </dont> + <do> + <p> + determine the order of events by saving a tuple + containing + <seealso marker="erlang#monotonic_time/0">monotonic time</seealso> + and a <seealso marker="erlang#unique_integer/1">strictly + monotonically increasing integer</seealso> like this:</p> + <code type="none"> +Time = erlang:monotonic_time(), +UMI = erlang:unique_integer([monotonic]), +EventTag = {Time, UMI}</code> + <p>These tuples will be strictly monotonically ordered + on the current runtime system instance according to + creation time. Note that it is important that the + monotonic time is in the first element (the most + significant element when comparing 2-tuples). Using + the monotonic time in the tuples, you can calculate time + between events.</p> + <p>If you are interested in the Erlang system time at the + time when the event occurred you can also save the time + offset before or after saving the events using + <seealso marker="erlang#time_offset/0"><c>erlang:time_offset/0</c></seealso>. + Erlang monotonic time added with the time + offset corresponds to Erlang system time.</p> + <p>If you are executing in a mode where time offset + may change and you want to be able to get the actual + Erlang system time when the event occurred you can + save the time offset as a third element in the tuple + (the least significant element when comparing 3-tuples).</p> + </do> + </section> + + <marker id="Dos_and_Donts_Create_a_Unique_Name"/> + <section> + <title>Create a Unique Name</title> + <dont> + <p> + use the values returned from <c>erlang:now/0</c> + in order to create a name unique on the current + runtime system instance. + </p> + </dont> + <do> + <p> + use the value returned from + <seealso marker="erlang#unique_integer/0"><c>erlang:unique_integer/0</c></seealso> + in order to create a name unique on the current runtime system + instance. If you only want positive integers, you can use + <seealso marker="erlang#unique_integer/1"><c>erlang:unique_integer([positive])</c></seealso>. + </p> + </do> + </section> + + <marker id="Dos_and_Donts_Seed_Random_Number_Generation_With_a_Unique_Value"/> + <section> + <title>Seed Random Number Generation With a Unique Value</title> + <dont> + <p> + seed random number generation using <c>erlang:now()</c>. + </p> + </dont> + <do> + <p> + seed random number generation using a combination of + <seealso marker="erlang#monotonic_time/0"><c>erlang:monotonic_time()</c></seealso>, + <seealso marker="erlang#time_offset/0"><c>erlang:time_offset()</c></seealso>, + <seealso marker="erlang#unique_integer/0"><c>erlang:unique_integer()</c></seealso>, and other functionality. + </p> + </do> + </section> + + <p>To sum this section up: <em>Don't use <c>erlang:now/0</c>!</em></p> + </section> </section> + + <marker id="Supporting_Both_New_and_Old_OTP_Releases"/> <section> - <title>Turning off time correction</title> - <p>If, for some reason, time correction causes trouble and you are - absolutely confident that the wall clock on the system is nearly - perfect, you can turn off time correction completely by giving the - <c>+c</c> option to <c>erl</c>. The probability for this being a - good idea, is very low.</p> + <title>Supporting Both New and Old OTP Releases</title> + <p>Your code may be required to be able to run on a variety + of OTP installations of different OTP releases. If so, you + can not just use the new API out of the box, since it will + not be available on old pre OTP 18 releases. The solution + is <em>not</em> to avoid using the new API, since your + code then won't be able to benefit from the scalability + and accuracy improvements made. Instead you want to use the + new API when available, and fall back on <c>erlang:now/0</c> + when it is not available. Fortunately almost all of the new + API can easily be implemented using existing primitives + (except for + <seealso marker="erlang#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso>, + <seealso marker="erlang#system_info_os_monotonic_time_source"><c>erlang:system_info(os_monotonic_time_source)</c></seealso>, and + <seealso marker="erlang#system_info_os_system_time_source"><c>erlang:system_info(os_system_time_source)</c></seealso>). + By wrapping the API with functions that fall back on + <c>erlang:now/0</c> when the new API is not available, + and using these wrappers instead of using the API directly + the problem is solved. These wrappers can for example + be implemented as in + <url href="time_compat.erl"><c>$ERL_TOP/erts/example/time_compat.erl</c></url>.</p> </section> </chapter> - diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml index da8ccdecdf..1f10ddef6d 100644 --- a/erts/doc/src/zlib.xml +++ b/erts/doc/src/zlib.xml @@ -99,7 +99,7 @@ list_to_binary([Compressed|Last])</pre> <datatype> <name name="zwindowbits"/> <desc> - <p>Normally in the range <c>-15..-9 | 9..15</c>.</p> + <p>Normally in the range <c>-15..-8 | 8..15</c>.</p> </desc> </datatype> </datatypes> @@ -149,7 +149,7 @@ list_to_binary([Compressed|Last])</pre> currently the only supported method is <c>deflated</c>.</p> <p>The <c><anno>WindowBits</anno></c> parameter is the base two logarithm of the window size (the size of the history buffer). It - should be in the range 9 through 15. Larger values + should be in the range 8 through 15. Larger values of this parameter result in better compression at the expense of memory usage. The default value is 15 if <c>deflateInit/2</c>. A negative <c><anno>WindowBits</anno></c> @@ -288,7 +288,7 @@ list_to_binary([B1,B2])</pre> <p>Initialize decompression session on zlib stream.</p> <p>The <c><anno>WindowBits</anno></c> parameter is the base two logarithm of the maximum window size (the size of the history buffer). - It should be in the range 9 through 15. + It should be in the range 8 through 15. The default value is 15 if <c>inflateInit/1</c> is used. If a compressed stream with a larger window size is given as input, inflate() will throw the <c>data_error</c> @@ -312,6 +312,53 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> + <name name="inflateChunk" arity="2"/> + <fsummary>Decompress data with limited output size</fsummary> + <desc> + <p>Like <c>inflate/2</c>, but decompress no more data than + will fit in the buffer configured via <c>setBufSize/2</c>. + Is is useful when decompressing a stream with a high compression + ratio such that a small amount of compressed input may expand up to + 1000 times. + It returns <c>{more, Decompressed}</c>, when there is more output + available, and <c>inflateChunk/1</c> should be used to read it. + It may introduce some output latency (reading + input without producing any output).</p> + <p>If a preset dictionary is needed at this point (see + <c>inflateSetDictionary</c> below), <c>inflateChunk/2</c> throws a + <c>{need_dictionary,Adler}</c> exception where <c>Adler</c> is + the adler32 checksum of the dictionary chosen by the + compressor.</p> + + <pre> +walk(Compressed, Handler) -> + Z = zlib:open(), + zlib:inflateInit(Z), + % Limit single uncompressed chunk size to 512kb + zlib:setBufSize(Z, 512 * 1024), + loop(Z, Handler, zlib:inflateChunk(Z, Compressed)), + zlib:inflateEnd(Z), + zlib:close(Z). + +loop(Z, Handler, {more, Uncompressed}) -> + Handler(Uncompressed), + loop(Z, Handler, zlib:inflateChunk(Z)); +loop(Z, Handler, Uncompressed) -> + Handler(Uncompressed). + </pre> + </desc> + </func> + <func> + <name name="inflateChunk" arity="1"/> + <fsummary>Read next uncompressed chunk</fsummary> + <desc> + <p>Read next chunk of uncompressed data, initialized by + <c>inflateChunk/2</c>.</p> + <p>This function should be repeatedly called, while it returns + <c>{more, Decompressed}</c>.</p> + </desc> + </func> + <func> <name name="inflateSetDictionary" arity="2"/> <fsummary>Initialize the decompression dictionary</fsummary> <desc> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index a632faf57d..659ea1b27f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -754,7 +754,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \ $(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \ $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ - $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_wrap.o \ + $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \ + $(OBJDIR)/erl_bif_wrap.o \ $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ @@ -778,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 \ @@ -887,7 +888,8 @@ OS_OBJS += $(OBJDIR)/erl_mseg.o \ $(OBJDIR)/erl_mmap.o \ $(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \ $(OBJDIR)/erl_mtrace_sys_wrap.o \ - $(OBJDIR)/erl_sys_common_misc.o + $(OBJDIR)/erl_sys_common_misc.o \ + $(OBJDIR)/erl_os_monotonic_time_extender.o HIPE_ARCH64_OBJS=$(OBJDIR)/hipe_bif64.o diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index c097866c7e..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,21 +95,24 @@ 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 atom backtrace backtrace_depth -atom badarg badarith badarity badfile badmatch badsig badfun +atom badarg badarith badarity badfile badfun badkey badmap badmatch badsig atom bag atom band atom big atom bif_return_trap +atom bif_timer_server atom binary atom binary_bin_to_list_trap atom binary_copy_trap @@ -144,9 +148,11 @@ atom catchlevel atom cd atom cdr atom cflags +atom CHANGE='CHANGE' atom characters_to_binary_int atom characters_to_list_int atom clear +atom clock_service atom close atom closed atom code @@ -156,6 +162,7 @@ atom compat_rel atom compile atom compressed atom config_h +atom convert_time_unit atom connect atom connected atom connection_closed @@ -237,7 +244,7 @@ atom first atom firstline atom flags atom flush -atom flush_monitor_message +atom flush_monitor_messages atom force atom format_cpu_topology atom free @@ -345,6 +352,8 @@ atom message_queue_len atom messages atom meta atom meta_match_spec +atom micro_seconds +atom milli_seconds atom min_heap_size atom min_bin_vheap_size atom minor_version @@ -355,12 +364,15 @@ atom monitored_by atom monitor atom monitor_nodes atom monitors +atom monotonic atom more atom multi_scheduling atom multiline +atom nano_seconds atom name atom named_table atom namelist +atom native atom native_addresses atom Neq='=/=' atom Neqeq='/=' @@ -451,6 +463,7 @@ atom ports atom port_count atom port_limit atom port_op +atom positive atom print atom priority atom private @@ -510,6 +523,7 @@ atom schedulers_online atom scheme atom scientific atom scope +atom seconds atom sensitive atom sequential_tracer atom sequential_trace_token @@ -555,6 +569,7 @@ atom term_to_binary_trap atom this atom thread_pool_size atom threads +atom time_offset atom timeout atom timeout_value atom Times='*' 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_debug.c b/erts/emulator/beam/beam_debug.c index a3cd08834f..0367ca8aba 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -579,9 +579,29 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) unpacked = ap; ap = addr + size; switch (op) { - case op_i_select_val_rfI: - case op_i_select_val_xfI: - case op_i_select_val_yfI: + case op_i_select_val_lins_rfI: + case op_i_select_val_lins_xfI: + case op_i_select_val_lins_yfI: + { + int n = ap[-1]; + int ix = n; + + while (ix--) { + erts_print(to, to_arg, "%T ", (Eterm) ap[0]); + ap++; + size++; + } + ix = n; + while (ix--) { + erts_print(to, to_arg, "f(" HEXF ") ", (Eterm) ap[0]); + ap++; + size++; + } + } + break; + case op_i_select_val_bins_rfI: + case op_i_select_val_bins_xfI: + case op_i_select_val_bins_yfI: { int n = ap[-1]; @@ -598,13 +618,19 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case op_i_select_tuple_arity_yfI: { int n = ap[-1]; + int ix = n; - while (n > 0) { + while (ix--) { Uint arity = arityval(ap[0]); - erts_print(to, to_arg, " {%d} f(" HEXF ")", arity, ap[1]); - ap += 2; - size += 2; - n--; + erts_print(to, to_arg, "{%d} ", arity, ap[1]); + ap++; + size++; + } + ix = n; + while (ix--) { + erts_print(to, to_arg, "f(" HEXF ") ", ap[0]); + ap++; + size++; } } break; @@ -635,10 +661,9 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case op_i_put_tuple_rI: case op_i_put_tuple_xI: case op_i_put_tuple_yI: - case op_new_map_jdII: + case op_new_map_dII: case op_update_map_assoc_jsdII: case op_update_map_exact_jsdII: - case op_i_has_map_fields_fsI: case op_i_get_map_elements_fsI: { int n = unpacked[-1]; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 3af7c43abf..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; } @@ -699,9 +703,7 @@ void** beam_ops; Fail; \ } -#define IsMap(Src, Fail) if (is_not_map(Src)) { Fail; } - -#define HasMapField(Src, Key, Fail) if (has_not_map_field(Src, Key)) { Fail; } +#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; } #define GetMapElement(Src, Key, Dst, Fail) \ do { \ @@ -712,6 +714,15 @@ void** beam_ops; Dst = _res; \ } while (0) +#define GetMapElementHash(Src, Key, Hx, Dst, Fail) \ + do { \ + Eterm _res = get_map_element_hash(Src, Key, Hx); \ + if (is_non_value(_res)) { \ + Fail; \ + } \ + Dst = _res; \ + } while (0) + #define IsFunction(X, Action) \ do { \ if ( !(is_any_fun(X)) ) { \ @@ -960,8 +971,8 @@ static Eterm update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) NOINLINE; static Eterm update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) NOINLINE; -static int has_not_map_field(Eterm map, Eterm key); static Eterm get_map_element(Eterm map, Eterm key); +static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx); /* * Functions not directly called by process_main(). OK to inline. @@ -1077,16 +1088,32 @@ init_emulator(void) DTRACE2(nif_return, process_name, mfa); \ } -#else /* USE_VM_PROBES */ - -#define DTRACE_LOCAL_CALL(p, m, f, a) do {} while (0) -#define DTRACE_GLOBAL_CALL(p, m, f, a) do {} while (0) -#define DTRACE_RETURN(p, m, f, a) do {} while (0) -#define DTRACE_BIF_ENTRY(p, m, f, a) do {} while (0) -#define DTRACE_BIF_RETURN(p, m, f, a) do {} while (0) -#define DTRACE_NIF_ENTRY(p, m, f, a) do {} while (0) -#define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0) +#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p,e) \ + do { \ + if (DTRACE_ENABLED(global_function_entry)) { \ + BeamInstr* fp = (BeamInstr *) (((Export *) (e))->addressv[erts_active_code_ix()]); \ + DTRACE_GLOBAL_CALL((p), (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]); \ + } \ + } while(0) + +#define DTRACE_RETURN_FROM_PC(p) \ + do { \ + BeamInstr* fp; \ + if (DTRACE_ENABLED(function_return) && (fp = find_function_from_pc((p)->cp))) { \ + DTRACE_RETURN((p), (Eterm)fp[0], (Eterm)fp[1], (Uint)fp[2]); \ + } \ + } while(0) +#else /* USE_VM_PROBES */ +#define DTRACE_LOCAL_CALL(p, m, f, a) do {} while (0) +#define DTRACE_GLOBAL_CALL(p, m, f, a) do {} while (0) +#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p, e) do {} while (0) +#define DTRACE_RETURN(p, m, f, a) do {} while (0) +#define DTRACE_RETURN_FROM_PC(p) do {} while (0) +#define DTRACE_BIF_ENTRY(p, m, f, a) do {} while (0) +#define DTRACE_BIF_RETURN(p, m, f, a) do {} while (0) +#define DTRACE_NIF_ENTRY(p, m, f, a) do {} while (0) +#define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0) #endif /* USE_VM_PROBES */ /* @@ -1366,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; @@ -1378,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; @@ -1476,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); } @@ -1523,12 +1642,7 @@ void process_main(void) * is not loaded, it points to code which will invoke the error handler * (see lb_call_error_handler below). */ -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(global_function_entry)) { - BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]); - DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]); - } -#endif + DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); OpCase(i_move_call_ext_cre): { @@ -1538,12 +1652,7 @@ void process_main(void) /* FALL THROUGH */ OpCase(i_call_ext_e): SET_CP(c_p, I+2); -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(global_function_entry)) { - BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]); - DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]); - } -#endif + DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); OpCase(i_move_call_ext_only_ecr): { @@ -1551,12 +1660,7 @@ void process_main(void) } /* FALL THROUGH */ OpCase(i_call_ext_only_e): -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(global_function_entry)) { - BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]); - DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]); - } -#endif + DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); OpCase(init_y): { @@ -1590,18 +1694,9 @@ void process_main(void) Next(1); } - OpCase(return): { -#ifdef USE_VM_CALL_PROBES - BeamInstr* fptr; -#endif SET_I(c_p->cp); - -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(function_return) && (fptr = find_function_from_pc(c_p->cp))) { - DTRACE_RETURN(c_p, (Eterm)fptr[0], (Eterm)fptr[1], (Uint)fptr[2]); - } -#endif + DTRACE_RETURN_FROM_PC(c_p); /* * We must clear the CP to make sure that a stale value do not * create a false module dependcy preventing code upgrading. @@ -2024,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; + } } } @@ -2110,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; } @@ -2138,19 +2221,18 @@ void process_main(void) NextPF(0, next); } - { Eterm select_val2; - OpCase(i_select_tuple_arity2_yfAfAf): + OpCase(i_select_tuple_arity2_yfAAff): select_val2 = yb(Arg(0)); goto do_select_tuple_arity2; - OpCase(i_select_tuple_arity2_xfAfAf): + OpCase(i_select_tuple_arity2_xfAAff): select_val2 = xb(Arg(0)); goto do_select_tuple_arity2; - OpCase(i_select_tuple_arity2_rfAfAf): + OpCase(i_select_tuple_arity2_rfAAff): select_val2 = r(0); I--; @@ -2161,22 +2243,22 @@ void process_main(void) select_val2 = *tuple_val(select_val2); goto do_select_val2; - OpCase(i_select_val2_yfcfcf): + OpCase(i_select_val2_yfccff): select_val2 = yb(Arg(0)); goto do_select_val2; - OpCase(i_select_val2_xfcfcf): + OpCase(i_select_val2_xfccff): select_val2 = xb(Arg(0)); goto do_select_val2; - OpCase(i_select_val2_rfcfcf): + OpCase(i_select_val2_rfccff): select_val2 = r(0); I--; do_select_val2: if (select_val2 == Arg(2)) { - I += 2; - } else if (select_val2 == Arg(4)) { + I += 3; + } else if (select_val2 == Arg(3)) { I += 4; } @@ -2203,20 +2285,50 @@ void process_main(void) do_select_tuple_arity: if (is_tuple(select_val)) { select_val = *tuple_val(select_val); - goto do_binary_search; + goto do_linear_search; + } + SET_I((BeamInstr *) Arg(1)); + Goto(*I); + + OpCase(i_select_val_lins_xfI): + select_val = xb(Arg(0)); + goto do_linear_search; + + OpCase(i_select_val_lins_yfI): + select_val = yb(Arg(0)); + goto do_linear_search; + + OpCase(i_select_val_lins_rfI): + select_val = r(0); + I--; + + do_linear_search: { + BeamInstr *vs = &Arg(3); + int ix = 0; + + for(;;) { + if (vs[ix+0] >= select_val) { ix += 0; break; } + if (vs[ix+1] >= select_val) { ix += 1; break; } + ix += 2; } + + if (vs[ix] == select_val) { + I += ix + Arg(2) + 2; + } + SET_I((BeamInstr *) Arg(1)); Goto(*I); + } - OpCase(i_select_val_xfI): + OpCase(i_select_val_bins_xfI): select_val = xb(Arg(0)); goto do_binary_search; - OpCase(i_select_val_yfI): + OpCase(i_select_val_bins_yfI): select_val = yb(Arg(0)); goto do_binary_search; - OpCase(i_select_val_rfI): + OpCase(i_select_val_bins_rfI): select_val = r(0); I--; @@ -2350,65 +2462,16 @@ void process_main(void) Goto(*I); } - OpCase(new_map_jdII): { + OpCase(new_map_dII): { Eterm res; x(0) = r(0); SWAPOUT; - res = new_map(c_p, reg, I); + res = new_map(c_p, reg, I-1); SWAPIN; r(0) = x(0); - StoreResult(res, Arg(1)); - Next(4+Arg(3)); - } - - OpCase(i_has_map_fields_fsI): { - map_t* mp; - Eterm map; - Eterm field; - Eterm *ks; - BeamInstr* fs; - Uint sz,n; - - GetArg1(1, map); - - /* this instruction assumes Arg1 is a map, - * i.e. that it follows a test is_map if needed. - */ - - mp = (map_t *)map_val(map); - sz = map_get_size(mp); - - if (sz == 0) { - SET_I((BeamInstr *) Arg(0)); - goto has_map_fields_fail; - } - - ks = map_get_keys(mp); - n = (Uint)Arg(2); - fs = &Arg(3); /* pattern fields */ - - ASSERT(n>0); - - while(sz) { - field = (Eterm)*fs; - if (EQ(field,*ks)) { - n--; - fs++; - if (n == 0) break; - } - ks++; sz--; - } - - if (n) { - SET_I((BeamInstr *) Arg(0)); - goto has_map_fields_fail; - } - - I += 4 + Arg(2); -has_map_fields_fail: - ASSERT(VALID_INSTR(*I)); - Goto(*I); + StoreResult(res, Arg(0)); + Next(3+Arg(2)); } #define PUT_TERM_REG(term, desc) \ @@ -2431,12 +2494,8 @@ do { \ OpCase(i_get_map_elements_fsI): { Eterm map; - map_t *mp; - Eterm field; - Eterm *ks; - Eterm *vs; BeamInstr *fs; - Uint sz,n; + Uint sz, n; GetArg1(1, map); @@ -2444,41 +2503,55 @@ do { \ * i.e. that it follows a test is_map if needed. */ - mp = (map_t *)map_val(map); - sz = map_get_size(mp); + n = (Uint)Arg(2) / 3; + fs = &Arg(3); /* pattern fields and target registers */ - if (sz == 0) { - SET_I((BeamInstr *) Arg(0)); - goto get_map_elements_fail; - } + if (is_flatmap(map)) { + flatmap_t *mp; + Eterm *ks; + Eterm *vs; - n = (Uint)Arg(2) / 2; - fs = &Arg(3); /* pattern fields and target registers */ - ks = map_get_keys(mp); - vs = map_get_values(mp); + mp = (flatmap_t *)flatmap_val(map); + sz = flatmap_get_size(mp); - while(sz) { - field = (Eterm)*fs; - if (EQ(field,*ks)) { - PUT_TERM_REG(*vs, fs[1]); - n--; - fs += 2; - /* no more values to fetch, we are done */ - if (n == 0) break; + if (sz == 0) { + ClauseFail(); } - ks++; sz--; - vs++; - } - if (n) { - SET_I((BeamInstr *) Arg(0)); - goto get_map_elements_fail; - } + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + while(sz) { + if (EQ((Eterm) fs[0], *ks)) { + PUT_TERM_REG(*vs, fs[1]); + n--; + fs += 3; + /* no more values to fetch, we are done */ + if (n == 0) { + I = fs; + Next(-1); + } + } + ks++, sz--, vs++; + } - I += 4 + Arg(2); -get_map_elements_fail: - ASSERT(VALID_INSTR(*I)); - Goto(*I); + ClauseFail(); + } else { + const Eterm *v; + Uint32 hx; + ASSERT(is_hashmap(map)); + while(n--) { + hx = fs[2]; + ASSERT(hx == hashmap_make_hash((Eterm)fs[0])); + if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) { + ClauseFail(); + } + PUT_TERM_REG(*v, fs[1]); + fs += 3; + } + I = fs; + Next(-1); + } } #undef PUT_TERM_REG @@ -2496,7 +2569,13 @@ get_map_elements_fail: StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { - goto badarg; + /* + * This can only happen if the code was compiled + * with the compiler in OTP 17. + */ + c_p->freason = BADMAP; + c_p->fvalue = map; + goto lb_Cl_error; } } @@ -2514,7 +2593,7 @@ get_map_elements_fail: StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { - goto badarg; + goto lb_Cl_error; } } @@ -2772,6 +2851,7 @@ get_map_elements_fail: } PreFetch(1, next); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); reg[0] = r(0); result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); @@ -2839,6 +2919,19 @@ get_map_elements_fail: 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; @@ -2854,6 +2947,20 @@ get_map_elements_fail: } } + 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; @@ -2869,6 +2976,8 @@ get_map_elements_fail: goto do_big_arith2; } +#undef DO_BIG_ARITH + do_big_arith2: { Eterm result; @@ -3520,6 +3629,8 @@ get_map_elements_fail: erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); reg[0] = r(0); nif_bif_result = (*fp)(&env, bif_nif_arity, reg); + if (env.exception_thrown) + nif_bif_result = THE_NON_VALUE; erts_post_nif(&env); } ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); @@ -3553,7 +3664,7 @@ get_map_elements_fail: vbf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); bif_nif_arity = I[-1]; - ASSERT(bif_nif_arity <= 3); + ASSERT(bif_nif_arity <= 4); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); reg[0] = r(0); { @@ -5141,8 +5252,6 @@ get_map_elements_fail: #ifndef NO_JUMP_TABLE #ifdef ERTS_OPCODE_COUNTER_SUPPORT - /* Are tables correctly generated by beam_makeops? */ - ERTS_CT_ASSERT(sizeof(counting_opcodes) == sizeof(opcodes)); #ifdef DEBUG counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); #endif @@ -5263,7 +5372,9 @@ Eterm error_atom[NUMBER_EXIT_CODES] = { am_notalive, /* 14 */ am_system_limit, /* 15 */ am_try_clause, /* 16 */ - am_notsup /* 17 */ + am_notsup, /* 17 */ + am_badmap, /* 18 */ + am_badkey, /* 19 */ }; /* @@ -5519,6 +5630,8 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) { case (GET_EXC_INDEX(EXC_TRY_CLAUSE)): case (GET_EXC_INDEX(EXC_BADFUN)): case (GET_EXC_INDEX(EXC_BADARITY)): + case (GET_EXC_INDEX(EXC_BADMAP)): + case (GET_EXC_INDEX(EXC_BADKEY)): /* Some common exceptions: value -> {atom, value} */ ASSERT(is_value(Value)); hp = HAlloc(c_p, 3); @@ -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); @@ -6029,13 +6142,7 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } - -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(global_function_entry)) { - BeamInstr *fptr = (BeamInstr *) ep->addressv[erts_active_code_ix()]; - DTRACE_GLOBAL_CALL(p, (Eterm)fptr[-3], (Eterm)fptr[-2], (Uint)fptr[-1]); - } -#endif + DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } @@ -6084,13 +6191,7 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } - -#ifdef USE_VM_CALL_PROBES - if (DTRACE_ENABLED(global_function_entry)) { - BeamInstr *fptr = (BeamInstr *) ep->addressv[erts_active_code_ix()]; - DTRACE_GLOBAL_CALL(p, (Eterm)fptr[-3], (Eterm)fptr[-2], (Uint)fptr[-1]); - } -#endif + DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } @@ -6412,57 +6513,75 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) return make_fun(funp); } -static int has_not_map_field(Eterm map, Eterm key) +static Eterm get_map_element(Eterm map, Eterm key) { - map_t* mp; - Eterm* keys; - Uint i; - Uint n; - - mp = (map_t *)map_val(map); - keys = map_get_keys(mp); - n = map_get_size(mp); - if (is_immed(key)) { - for (i = 0; i < n; i++) { - if (keys[i] == key) { - return 0; + Uint32 hx; + const Eterm *vs; + if (is_flatmap(map)) { + flatmap_t *mp; + Eterm *ks; + Uint i; + Uint n; + + mp = (flatmap_t *)flatmap_val(map); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + n = flatmap_get_size(mp); + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (ks[i] == key) { + return vs[i]; + } } - } - } else { - for (i = 0; i < n; i++) { - if (EQ(keys[i], key)) { - return 0; + } else { + for (i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + return vs[i]; + } } } + return THE_NON_VALUE; } - return 1; + ASSERT(is_hashmap(map)); + hx = hashmap_make_hash(key); + vs = erts_hashmap_get(hx,key,map); + return vs ? *vs : THE_NON_VALUE; } -static Eterm get_map_element(Eterm map, Eterm key) +static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx) { - map_t *mp; - Eterm* ks, *vs; - Uint i; - Uint n; - - mp = (map_t *)map_val(map); - ks = map_get_keys(mp); - vs = map_get_values(mp); - n = map_get_size(mp); - if (is_immed(key)) { - for (i = 0; i < n; i++) { - if (ks[i] == key) { - return vs[i]; + const Eterm *vs; + + if (is_flatmap(map)) { + flatmap_t *mp; + Eterm *ks; + Uint i; + Uint n; + + mp = (flatmap_t *)flatmap_val(map); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + n = flatmap_get_size(mp); + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (ks[i] == key) { + return vs[i]; + } } - } - } else { - for (i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - return vs[i]; + } else { + for (i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + return vs[i]; + } } } + return THE_NON_VALUE; } - return THE_NON_VALUE; + + ASSERT(is_hashmap(map)); + ASSERT(hx == hashmap_make_hash(key)); + vs = erts_hashmap_get(hx, key, map); + return vs ? *vs : THE_NON_VALUE; } #define GET_TERM(term, dest) \ @@ -6495,7 +6614,39 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) Eterm *mhp,*thp; Eterm *E; BeamInstr *ptr; - map_t *mp; + flatmap_t *mp; + ErtsHeapFactory factory; + + ptr = &Arg(4); + + if (n > 2*MAP_SMALL_MAP_LIMIT) { + Eterm res; + if (HeapWordsLeft(p) < n) { + erts_garbage_collect(p, n, reg, Arg(2)); + } + + mhp = p->htop; + thp = p->htop; + E = p->stop; + + for (i = 0; i < n/2; i++) { + GET_TERM(*ptr++, *mhp++); + GET_TERM(*ptr++, *mhp++); + } + + p->htop = mhp; + + factory.p = p; + res = erts_hashmap_from_array(&factory, thp, n/2, 0); + if (p->mbuf) { + Uint live = Arg(2); + reg[live] = res; + erts_garbage_collect(p, 0, reg, live+1); + res = reg[live]; + E = p->stop; + } + return res; + } if (HeapWordsLeft(p) < need) { erts_garbage_collect(p, need, reg, Arg(2)); @@ -6504,12 +6655,11 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) thp = p->htop; mhp = thp + 1 + n/2; E = p->stop; - ptr = &Arg(4); keys = make_tuple(thp); *thp++ = make_arityval(n/2); - mp = (map_t *)mhp; mhp += MAP_HEADER_SIZE; - mp->thing_word = MAP_HEADER; + mp = (flatmap_t *)mhp; mhp += MAP_HEADER_FLATMAP_SZ; + mp->thing_word = MAP_HEADER_FLATMAP; mp->size = n/2; mp->keys = keys; @@ -6518,7 +6668,7 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) GET_TERM(*ptr++, *mhp++); } p->htop = mhp; - return make_map(mp); + return make_flatmap(mp); } static Eterm @@ -6528,7 +6678,7 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) Uint num_old; Uint num_updates; Uint need; - map_t *old_mp, *mp; + flatmap_t *old_mp, *mp; Eterm res; Eterm* hp; Eterm* E; @@ -6538,12 +6688,43 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) Eterm new_key; Eterm* kp; - if (is_not_map(map)) { - return THE_NON_VALUE; + new_p = &Arg(5); + num_updates = Arg(4) / 2; + + if (is_not_flatmap(map)) { + Uint32 hx; + Eterm val; + + /* apparently the compiler does not emit is_map instructions, + * bad compiler */ + + if (is_not_hashmap(map)) + return THE_NON_VALUE; + + res = map; + E = p->stop; + while(num_updates--) { + /* assoc can't fail */ + GET_TERM(new_p[0], new_key); + GET_TERM(new_p[1], val); + hx = hashmap_make_hash(new_key); + + res = erts_hashmap_insert(p, hx, new_key, val, res, 0); + if (p->mbuf) { + Uint live = Arg(3); + reg[live] = res; + erts_garbage_collect(p, 0, reg, live+1); + res = reg[live]; + E = p->stop; + } + + new_p += 2; + } + return res; } - old_mp = (map_t *) map_val(map); - num_old = map_get_size(old_mp); + old_mp = (flatmap_t *) flatmap_val(map); + num_old = flatmap_get_size(old_mp); /* * If the old map is empty, create a new map. @@ -6558,14 +6739,13 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) * update list are new). */ - num_updates = Arg(4) / 2; - need = 2*(num_old+num_updates) + 1 + MAP_HEADER_SIZE; + need = 2*(num_old+num_updates) + 1 + MAP_HEADER_FLATMAP_SZ; if (HeapWordsLeft(p) < need) { Uint live = Arg(3); reg[live] = map; erts_garbage_collect(p, need, reg, live+1); map = reg[live]; - old_mp = (map_t *)map_val(map); + old_mp = (flatmap_t *)flatmap_val(map); } /* @@ -6596,16 +6776,15 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) kp = p->htop + 1; /* Point to first key */ hp = kp + num_old + num_updates; - res = make_map(hp); - mp = (map_t *)hp; - hp += MAP_HEADER_SIZE; - mp->thing_word = MAP_HEADER; + res = make_flatmap(hp); + mp = (flatmap_t *)hp; + hp += MAP_HEADER_FLATMAP_SZ; + mp->thing_word = MAP_HEADER_FLATMAP; mp->keys = make_tuple(kp-1); - old_vals = map_get_values(old_mp); - old_keys = map_get_keys(old_mp); + old_vals = flatmap_get_values(old_mp); + old_keys = flatmap_get_keys(old_mp); - new_p = &Arg(5); GET_TERM(*new_p, new_key); n = num_updates; @@ -6691,8 +6870,19 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) n = kp - p->htop - 1; /* Actual number of keys/values */ *p->htop = make_arityval(n); + p->htop = hp; mp->size = n; - p->htop = hp; + + /* The expensive case, need to build a hashmap */ + if (n > MAP_SMALL_MAP_LIMIT) { + res = erts_hashmap_from_ks_and_vs(p,flatmap_get_keys(mp),flatmap_get_values(mp),n); + if (p->mbuf) { + Uint live = Arg(3); + reg[live] = res; + erts_garbage_collect(p, 0, reg, live+1); + res = reg[live]; + } + } return res; } @@ -6707,7 +6897,7 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) Uint i; Uint num_old; Uint need; - map_t *old_mp, *mp; + flatmap_t *old_mp, *mp; Eterm res; Eterm* hp; Eterm* E; @@ -6716,18 +6906,61 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) BeamInstr* new_p; Eterm new_key; - if (is_not_map(map)) { - return THE_NON_VALUE; + new_p = &Arg(5); + n = Arg(4) / 2; /* Number of values to be updated */ + ASSERT(n > 0); + + if (is_not_flatmap(map)) { + Uint32 hx; + Eterm val; + + /* apparently the compiler does not emit is_map instructions, + * bad compiler */ + + if (is_not_hashmap(map)) { + p->freason = BADMAP; + p->fvalue = map; + return THE_NON_VALUE; + } + + res = map; + E = p->stop; + while(n--) { + GET_TERM(new_p[0], new_key); + GET_TERM(new_p[1], val); + hx = hashmap_make_hash(new_key); + + res = erts_hashmap_insert(p, hx, new_key, val, res, 1); + if (is_non_value(res)) { + p->fvalue = new_key; + p->freason = BADKEY; + return res; + } + + if (p->mbuf) { + Uint live = Arg(3); + reg[live] = res; + erts_garbage_collect(p, 0, reg, live+1); + res = reg[live]; + E = p->stop; + } + + new_p += 2; + } + return res; } - old_mp = (map_t *) map_val(map); - num_old = map_get_size(old_mp); + old_mp = (flatmap_t *) flatmap_val(map); + num_old = flatmap_get_size(old_mp); /* - * If the old map is empty, create a new map. + * If the old map is empty, fail. */ if (num_old == 0) { + E = p->stop; + p->freason = BADKEY; + GET_TERM(new_p[0], p->fvalue); return THE_NON_VALUE; } @@ -6735,13 +6968,13 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) * Allocate the exact heap space needed. */ - need = num_old + MAP_HEADER_SIZE; + need = num_old + MAP_HEADER_FLATMAP_SZ; if (HeapWordsLeft(p) < need) { Uint live = Arg(3); reg[live] = map; erts_garbage_collect(p, need, reg, live+1); map = reg[live]; - old_mp = (map_t *)map_val(map); + old_mp = (flatmap_t *)flatmap_val(map); } /* @@ -6751,23 +6984,20 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) hp = p->htop; E = p->stop; - old_vals = map_get_values(old_mp); - old_keys = map_get_keys(old_mp); + old_vals = flatmap_get_values(old_mp); + old_keys = flatmap_get_keys(old_mp); - res = make_map(hp); - mp = (map_t *)hp; - hp += MAP_HEADER_SIZE; - mp->thing_word = MAP_HEADER; + res = make_flatmap(hp); + mp = (flatmap_t *)hp; + hp += MAP_HEADER_FLATMAP_SZ; + mp->thing_word = MAP_HEADER_FLATMAP; mp->size = num_old; mp->keys = old_mp->keys; /* Get array of key/value pairs to be updated */ - new_p = &Arg(5); GET_TERM(*new_p, new_key); /* Update all values */ - n = Arg(4) / 2; /* Number of values to be updated */ - ASSERT(n > 0); for (i = 0; i < num_old; i++) { if (!EQ(*old_keys, new_key)) { /* Not same keys */ @@ -6800,6 +7030,8 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) * update list did not previously exist. */ ASSERT(hp == p->htop + need); + p->freason = BADKEY; + p->fvalue = new_key; return THE_NON_VALUE; } #undef GET_TERM diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 07654f6d5c..0d40201934 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -36,6 +36,7 @@ #include "beam_catches.h" #include "erl_binary.h" #include "erl_zlib.h" +#include "erl_map.h" #ifdef HIPE #include "hipe_bif0.h" @@ -529,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); @@ -3171,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)); } @@ -3321,9 +3327,10 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, { GenOp* op; + GenOpArg *tmp; int arity = Size.val + 3; int size = Size.val / 2; - int i; + int i, j, align = 0; /* * Verify the validity of the list. @@ -3338,9 +3345,37 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, } /* + * Use a special-cased instruction if there are only two values. + */ + if (size == 2) { + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_tuple_arity2_6; + GENOP_ARITY(op, arity - 1); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Rest[0].val; + op->a[3].type = TAG_u; + op->a[3].val = Rest[2].val; + op->a[4] = Rest[1]; + op->a[5] = Rest[3]; + + return op; + } + + /* * Generate the generic instruction. + * Assumption: + * Few different tuple arities to select on (fewer than 20). + * Use linear scan approach. */ + align = 1; + + arity += 2*align; + size += align; + NEW_GENOP(stp, op); op->next = NULL; op->op = genop_i_select_tuple_arity_3; @@ -3348,39 +3383,36 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, op->a[0] = S; op->a[1] = Fail; op->a[2].type = TAG_u; - op->a[2].val = Size.val / 2; - for (i = 0; i < Size.val; i += 2) { - op->a[i+3].type = TAG_v; - op->a[i+3].val = make_arityval(Rest[i].val); - op->a[i+4] = Rest[i+1]; - } + op->a[2].val = size; - /* - * Sort the values to make them useful for a binary search. - */ + tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); - qsort(op->a+3, size, 2*sizeof(GenOpArg), - (int (*)(const void *, const void *)) genopargcompare); -#ifdef DEBUG - for (i = 3; i < arity-2; i += 2) { - ASSERT(op->a[i].val < op->a[i+2].val); + for (i = 3; i < arity - 2*align; i+=2) { + tmp[i-3].type = TAG_v; + tmp[i-3].val = make_arityval(Rest[i-3].val); + tmp[i-2] = Rest[i-2]; } -#endif /* - * Use a special-cased instruction if there are only two values. + * Sort the values to make them useful for a sentinel search */ - if (size == 2) { - op->op = genop_i_select_tuple_arity2_6; - op->arity--; - op->a[2].type = TAG_u; - op->a[2].val = arityval(op->a[3].val); - op->a[3] = op->a[4]; - op->a[4].type = TAG_u; - op->a[4].val = arityval(op->a[5].val); - op->a[5] = op->a[6]; + + qsort(tmp, size - align, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); + + j = 3; + for (i = 3; i < arity - 2*align; i += 2) { + op->a[j] = tmp[i-3]; + op->a[j + size] = tmp[i-2]; + j++; } + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); + + op->a[j].type = TAG_u; + op->a[j].val = ~((BeamInstr)0); + op->a[j+size] = Fail; + return op; } @@ -3602,45 +3634,109 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) { GenOp* op; + GenOpArg *tmp; int arity = Size.val + 3; int size = Size.val / 2; - int i; + int i, j, align = 0; + + if (size == 2) { + + /* + * Use a special-cased instruction if there are only two values. + */ + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_val2_6; + GENOP_ARITY(op, arity - 1); + op->a[0] = S; + op->a[1] = Fail; + op->a[2] = Rest[0]; + op->a[3] = Rest[2]; + op->a[4] = Rest[1]; + op->a[5] = Rest[3]; + + return op; + + } else if (size > 10) { + + /* binary search instruction */ + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_val_bins_3; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + for (i = 3; i < arity; i++) { + op->a[i] = Rest[i-3]; + } + + /* + * Sort the values to make them useful for a binary search. + */ + + qsort(op->a+3, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); +#ifdef DEBUG + for (i = 3; i < arity-2; i += 2) { + ASSERT(op->a[i].val < op->a[i+2].val); + } +#endif + return op; + } + + /* linear search instruction */ + + align = 1; + + arity += 2*align; + size += align; NEW_GENOP(stp, op); op->next = NULL; - op->op = genop_i_select_val_3; + op->op = genop_i_select_val_lins_3; GENOP_ARITY(op, arity); op->a[0] = S; op->a[1] = Fail; op->a[2].type = TAG_u; op->a[2].val = size; - for (i = 3; i < arity; i++) { - op->a[i] = Rest[i-3]; + + tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); + + for (i = 3; i < arity - 2*align; i++) { + tmp[i-3] = Rest[i-3]; } /* - * Sort the values to make them useful for a binary search. + * Sort the values to make them useful for a sentinel search */ - qsort(op->a+3, size, 2*sizeof(GenOpArg), - (int (*)(const void *, const void *)) genopargcompare); -#ifdef DEBUG - for (i = 3; i < arity-2; i += 2) { - ASSERT(op->a[i].val < op->a[i+2].val); + qsort(tmp, size - align, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); + + j = 3; + for (i = 3; i < arity - 2*align; i += 2) { + op->a[j] = tmp[i-3]; + op->a[j+size] = tmp[i-2]; + j++; } -#endif - /* - * Use a special-cased instruction if there are only two values. - */ - if (size == 2) { - op->op = genop_i_select_val2_6; - op->arity--; - op->a[2] = op->a[3]; - op->a[3] = op->a[4]; - op->a[4] = op->a[5]; - op->a[5] = op->a[6]; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); + + /* add sentinel */ + + op->a[j].type = TAG_u; + op->a[j].val = ~((BeamInstr)0); + op->a[j+size] = Fail; + +#ifdef DEBUG + for (i = 0; i < size - 1; i++) { + ASSERT(op->a[i+3].val <= op->a[i+4].val); } +#endif return op; } @@ -3961,8 +4057,139 @@ tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, } /* + * Predicate to test whether the given literal is a map. + */ + +static int +literal_is_map(LoaderState* stp, GenOpArg Lit) +{ + Eterm term; + + ASSERT(Lit.type == TAG_q); + term = stp->literals[Lit.val].term; + return is_map(term); +} + +/* + * Predicate to test whether the given literal is an empty map. + */ + +static int +is_empty_map(LoaderState* stp, GenOpArg Lit) +{ + Eterm term; + + if (Lit.type != TAG_q) { + return 0; + } + term = stp->literals[Lit.val].term; + return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0; +} + +/* + * Pseudo predicate map_key_sort that will sort the Rest operand for + * map instructions as a side effect. + */ + +typedef struct SortGenOpArg { + Eterm term; /* Term to use for comparing */ + GenOpArg arg; /* Original data */ +} SortGenOpArg; + +static int +genopargtermcompare(SortGenOpArg* a, SortGenOpArg* b) +{ + return CMP_TERM(a->term, b->term); +} + +static int +map_key_sort(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + SortGenOpArg* t; + unsigned size = Size.val; + unsigned i; + + if (size == 2) { + return 1; /* Already sorted. */ + } + + + t = (SortGenOpArg *) erts_alloc(ERTS_ALC_T_TMP, size*sizeof(SortGenOpArg)); + + /* + * Copy original data and sort keys to a temporary array. + */ + for (i = 0; i < size; i += 2) { + t[i].arg = Rest[i]; + switch (Rest[i].type) { + case TAG_a: + t[i].term = Rest[i].val; + ASSERT(is_atom(t[i].term)); + break; + case TAG_i: + t[i].term = make_small(Rest[i].val); + break; + case TAG_n: + t[i].term = NIL; + break; + case TAG_q: + t[i].term = stp->literals[Rest[i].val].term; + break; + default: + /* + * Not a literal key. Not allowed. Only a single + * variable key is allowed in each map instruction. + */ + erts_free(ERTS_ALC_T_TMP, (void *) t); + return 0; + } +#ifdef DEBUG + t[i+1].term = THE_NON_VALUE; +#endif + t[i+1].arg = Rest[i+1]; + } + + /* + * Sort the temporary array. + */ + qsort((void *) t, size / 2, 2 * sizeof(SortGenOpArg), + (int (*)(const void *, const void *)) genopargtermcompare); + + /* + * Copy back the sorted, original data. + */ + for (i = 0; i < size; i++) { + Rest[i] = t[i].arg; + } + + erts_free(ERTS_ALC_T_TMP, (void *) t); + return 1; +} + +static int +hash_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx) +{ + switch (Key.type) { + case TAG_a: + *hx = hashmap_make_hash(Key.val); + return 1; + case TAG_i: + *hx = hashmap_make_hash(make_small(Key.val)); + return 1; + case TAG_n: + *hx = hashmap_make_hash(NIL); + return 1; + case TAG_q: + *hx = hashmap_make_hash(stp->literals[Key.val].term); + return 1; + default: + return 0; + } +} + +/* * Replace a get_map_elements with one key to an instruction with one - * element + * element. */ static GenOp* @@ -3970,37 +4197,99 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, GenOpArg Size, GenOpArg* Rest) { GenOp* op; + GenOpArg Key; + Uint32 hx = 0; ASSERT(Size.type == TAG_u); NEW_GENOP(stp, op); op->next = NULL; - op->op = genop_get_map_element_4; - op->arity = 4; - op->a[0] = Fail; op->a[1] = Src; op->a[2] = Rest[0]; - op->a[3] = Rest[1]; + + Key = Rest[0]; + if (hash_genop_arg(stp, Key, &hx)) { + op->arity = 5; + op->op = genop_i_get_map_element_hash_5; + op->a[3].type = TAG_u; + op->a[3].val = (BeamInstr) hx; + op->a[4] = Rest[1]; + } else { + op->arity = 4; + op->op = genop_i_get_map_element_4; + op->a[3] = Rest[1]; + } return op; } static GenOp* -gen_has_map_field(LoaderState* stp, GenOpArg Fail, GenOpArg Src, - GenOpArg Size, GenOpArg* Rest) +gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src, + GenOpArg Size, GenOpArg* Rest) { GenOp* op; + Uint32 hx; + Uint i; + GenOpArg* dst; +#ifdef DEBUG + int good_hash; +#endif ASSERT(Size.type == TAG_u); NEW_GENOP(stp, op); + op->op = genop_i_get_map_elements_3; + GENOP_ARITY(op, 3 + 3*(Size.val/2)); op->next = NULL; - op->op = genop_has_map_field_3; - op->arity = 4; + op->a[0] = Fail; + op->a[1] = Src; + op->a[2].type = TAG_u; + op->a[2].val = 3*(Size.val/2); + + dst = op->a+3; + for (i = 0; i < Size.val / 2; i++) { + dst[0] = Rest[2*i]; + dst[1] = Rest[2*i+1]; +#ifdef DEBUG + good_hash = +#endif + hash_genop_arg(stp, dst[0], &hx); +#ifdef DEBUG + ASSERT(good_hash); +#endif + dst[2].type = TAG_u; + dst[2].val = (BeamInstr) hx; + dst += 3; + } + return op; +} + +static GenOp* +gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + Uint i; + Uint n; + + ASSERT(Size.type == TAG_u); + n = Size.val; + + NEW_GENOP(stp, op); + GENOP_ARITY(op, 3 + 2*n); + op->next = NULL; + op->op = genop_get_map_elements_3; op->a[0] = Fail; op->a[1] = Src; - op->a[2] = Rest[0]; + op->a[2].type = TAG_u; + op->a[2].val = 2*n; + + for (i = 0; i < n; i++) { + op->a[3+2*i] = Rest[i]; + op->a[3+2*i+1].type = TAG_x; + op->a[3+2*i+1].val = 0; /* x(0); normally not used */ + } return op; } @@ -4982,7 +5271,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code, arity = count/sizeof(Eterm); *result = new_literal(stp, &hp, arity+1); - (void) bytes_to_big(bigbuf, count, neg, hp); + if (is_nil(bytes_to_big(bigbuf, count, neg, hp))) + goto load_error; if (bigbuf != default_buf) { erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); @@ -5119,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); @@ -5144,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; } @@ -5204,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},...] * @@ -5406,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; } @@ -5879,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; @@ -5907,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; } @@ -5962,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; @@ -6068,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/benchmark.h b/erts/emulator/beam/benchmark.h index 904564a96b..7fc3933f3d 100644 --- a/erts/emulator/beam/benchmark.h +++ b/erts/emulator/beam/benchmark.h @@ -141,10 +141,10 @@ extern unsigned long long major_gc; /* (Assuming Solaris) */ -#define BM_TIMER_T hrtime_t -#define BM_START_TIMER(t) system_clock = sys_gethrtime() +#define BM_TIMER_T ErtsMonotonicTime +#define BM_START_TIMER(t) system_clock = ERTS_MONOTONIC_TO_NSEC(erts_os_monotonic_time()) #define BM_STOP_TIMER(t) do { \ - BM_TIMER_T tmp = (sys_gethrtime() - system_clock) - timer_time; \ + BM_TIMER_T tmp = (ERTS_MONOTONIC_TO_NSEC(erts_os_monotonic_time()) - system_clock) - timer_time; \ t##_time += (tmp > 0 ? tmp : 0); \ } while(0) diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 49996e7f0b..2b782f4484 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -42,16 +42,23 @@ #define ERTS_PTAB_WANT_BIF_IMPL__ #include "erl_ptab.h" #include "erl_bits.h" +#include "erl_bif_unique.h" -static Export* flush_monitor_message_trap = NULL; +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; static Export* await_port_send_result_trap = NULL; Export* erts_format_cpu_topology_trap = NULL; static Export dsend_continue_trap_export; +Export *erts_convert_time_unit_trap = NULL; + static Export *await_sched_wall_time_mod_trap; static erts_smp_atomic32_t sched_wall_time; +static erts_smp_mtx_t ports_snapshot_mtx; +erts_smp_atomic_t erts_dead_ports_ptr; /* To store dying ports during snapshot */ + #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) /* @@ -393,7 +400,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to) return res; } -static int demonitor(Process *c_p, Eterm ref) +static int demonitor(Process *c_p, Eterm ref, Eterm *multip) { ErtsMonitor *mon = NULL; /* The monitor entry to delete */ Process *rp; /* Local target process */ @@ -417,65 +424,73 @@ static int demonitor(Process *c_p, Eterm ref) goto done; } - if (mon->type != MON_ORIGIN) { - res = ERTS_DEMONITOR_BADARG; - goto done; - } - to = mon->pid; - - if (is_atom(to)) { - /* Monitoring a name at node to */ - ASSERT(is_node_name_atom(to)); - dep = erts_sysname_to_connected_dist_entry(to); - ASSERT(dep != erts_this_dist_entry); - if (dep) - deref_de = 1; - } else { - ASSERT(is_pid(to)); - dep = pid_dist_entry(to); - } - if (dep != erts_this_dist_entry) { - res = remote_demonitor(c_p, dep, ref, to); - /* remote_demonitor() unlocks link lock on c_p */ - unlock_link = 0; - } - else { /* Local monitor */ - if (deref_de) { - deref_de = 0; - erts_deref_dist_entry(dep); + switch (mon->type) { + case MON_TIME_OFFSET: + *multip = am_true; + erts_demonitor_time_offset(ref); + res = ERTS_DEMONITOR_TRUE; + break; + case MON_ORIGIN: + to = mon->pid; + *multip = am_false; + if (is_atom(to)) { + /* Monitoring a name at node to */ + ASSERT(is_node_name_atom(to)); + dep = erts_sysname_to_connected_dist_entry(to); + ASSERT(dep != erts_this_dist_entry); + if (dep) + deref_de = 1; + } else { + ASSERT(is_pid(to)); + dep = pid_dist_entry(to); } - dep = NULL; - rp = erts_pid2proc_opt(c_p, - ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, - to, - ERTS_PROC_LOCK_LINK, - ERTS_P2P_FLG_ALLOW_OTHER_X); - mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref); + if (dep != erts_this_dist_entry) { + res = remote_demonitor(c_p, dep, ref, to); + /* remote_demonitor() unlocks link lock on c_p */ + unlock_link = 0; + } + else { /* Local monitor */ + if (deref_de) { + deref_de = 0; + erts_deref_dist_entry(dep); + } + dep = NULL; + rp = erts_pid2proc_opt(c_p, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + to, + ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref); #ifndef ERTS_SMP - ASSERT(mon); + ASSERT(mon); #else - if (!mon) - res = ERTS_DEMONITOR_FALSE; - else + if (!mon) + res = ERTS_DEMONITOR_FALSE; + else #endif - { - res = ERTS_DEMONITOR_TRUE; - erts_destroy_monitor(mon); - } - if (rp) { - ErtsMonitor *rmon; - rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref); - if (rp != c_p) - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); - if (rmon != NULL) - erts_destroy_monitor(rmon); - } - else { - ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p); - } + { + res = ERTS_DEMONITOR_TRUE; + erts_destroy_monitor(mon); + } + if (rp) { + ErtsMonitor *rmon; + rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref); + if (rp != c_p) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (rmon != NULL) + erts_destroy_monitor(rmon); + } + else { + ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p); + } + } + break; + default: + res = ERTS_DEMONITOR_BADARG; + *multip = am_false; + break; } - done: if (unlock_link) @@ -492,7 +507,8 @@ static int demonitor(Process *c_p, Eterm ref) BIF_RETTYPE demonitor_1(BIF_ALIST_1) { - switch (demonitor(BIF_P, BIF_ARG_1)) { + Eterm multi; + switch (demonitor(BIF_P, BIF_ARG_1, &multi)) { case ERTS_DEMONITOR_FALSE: case ERTS_DEMONITOR_TRUE: BIF_RET(am_true); @@ -510,6 +526,7 @@ BIF_RETTYPE demonitor_1(BIF_ALIST_1) BIF_RETTYPE demonitor_2(BIF_ALIST_2) { Eterm res = am_true; + Eterm multi = am_false; int info = 0; int flush = 0; Eterm list = BIF_ARG_2; @@ -532,13 +549,18 @@ BIF_RETTYPE demonitor_2(BIF_ALIST_2) if (is_not_nil(list)) goto badarg; - switch (demonitor(BIF_P, BIF_ARG_1)) { + switch (demonitor(BIF_P, BIF_ARG_1, &multi)) { case ERTS_DEMONITOR_FALSE: if (info) res = am_false; - if (flush) - BIF_TRAP2(flush_monitor_message_trap, BIF_P, BIF_ARG_1, res); + if (flush) { + flush_messages: + BIF_TRAP3(flush_monitor_messages_trap, BIF_P, + BIF_ARG_1, multi, res); + } case ERTS_DEMONITOR_TRUE: + if (multi == am_true && flush) + goto flush_messages; BIF_RET(res); case ERTS_DEMONITOR_YIELD_TRUE: ERTS_BIF_YIELD_RETURN(BIF_P, am_true); @@ -589,22 +611,16 @@ erts_queue_monitor_message(Process *p, ref_copy = copy_struct(ref, ref_size, &hp, ohp); tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy); - erts_queue_message(p, p_locksp, bp, tup, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(p, p_locksp, bp, tup, NIL); } static BIF_RETTYPE -local_pid_monitor(Process *p, Eterm target) +local_pid_monitor(Process *p, Eterm target, Eterm mon_ref, int bool) { BIF_RETTYPE ret; - Eterm mon_ref; Process *rp; ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK; - mon_ref = erts_make_ref(p); ERTS_BIF_PREP_RET(ret, mon_ref); if (target == p->common.id) { return ret; @@ -617,12 +633,18 @@ local_pid_monitor(Process *p, Eterm target) if (!rp) { erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); p_locks &= ~ERTS_PROC_LOCK_LINK; - erts_queue_monitor_message(p, &p_locks, - mon_ref, am_process, target, am_noproc); + if (bool) + ret = am_false; + else + erts_queue_monitor_message(p, &p_locks, + mon_ref, am_process, target, am_noproc); } else { ASSERT(rp != p); + if (bool) + ret = am_true; + erts_add_monitor(&ERTS_P_MONITORS(p), MON_ORIGIN, mon_ref, target, NIL); erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, mon_ref, p->common.id, NIL); @@ -746,13 +768,28 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) int deref_de = 0; /* Only process monitors are implemented */ - if (BIF_ARG_1 != am_process) { + switch (BIF_ARG_1) { + case am_time_offset: { + Eterm ref; + if (BIF_ARG_2 != am_clock_service) + goto error; + ref = erts_make_ref(BIF_P); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_add_monitor(&ERTS_P_MONITORS(BIF_P), MON_TIME_OFFSET, + ref, am_clock_service, NIL); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_monitor_time_offset(BIF_P->common.id, ref); + BIF_RET(ref); + } + case am_process: + break; + default: goto error; } if (is_internal_pid(target)) { local_pid: - ret = local_pid_monitor(BIF_P, target); + ret = local_pid_monitor(BIF_P, target, erts_make_ref(BIF_P), 0); } else if (is_external_pid(target)) { dep = external_pid_dist_entry(target); if (dep == erts_this_dist_entry) @@ -795,7 +832,6 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) return ret; } - /**********************************************************************/ /* this is a combination of the spawn and link BIFs */ @@ -2871,7 +2907,7 @@ static int do_list_to_integer(Process *p, Eterm orig_list, Uint ui = 0; int skip = 0; int neg = 0; - int n = 0; + Sint n = 0; int m; int lg2; Eterm res; @@ -2951,7 +2987,9 @@ static int do_list_to_integer(Process *p, Eterm orig_list, else i = (Sint)ui; res = make_small(i); } else { - lg2 = (n+1)*230/69+1; + /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 + which we round up to (3 + 1/3) */ + lg2 = (n+1)*3 + (n+1)/3 + 1; m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ m = BIG_NEED_SIZE(m); /* number of words + thing */ @@ -3542,91 +3580,6 @@ BIF_RETTYPE self_0(BIF_ALIST_0) /**********************************************************************/ -/* - New representation of refs in R9, see erl_term.h - - In the first data word, only the usual 18 bits are used. Ordinarily, - in "long refs" all words are used (in other words, practically never - wrap around), but for compatibility with older nodes, "short refs" - exist. Short refs come into being by being converted from the old - external format for refs (tag REFERENCE_EXT). Short refs are - converted back to the old external format. - - When converting a long ref to the external format in the case of - preparing for sending to an older node, the ref is truncated by only - using the first word (with 18 significant bits), and using the old tag - REFERENCE_EXT. - - When comparing refs or different size, only the parts up to the length - of the shorter operand are used. This has the desirable effect that a - long ref sent to an old node and back will be treated as equal to - the original, although some of the bits have been lost. - - The hash value for a ref always considers only the first word, since - in the above scenario, the original and the copy should have the same - hash value. -*/ - -static Uint32 reference0; /* Initialized in erts_init_bif */ -static Uint32 reference1; -static Uint32 reference2; -static erts_smp_spinlock_t make_ref_lock; -static erts_smp_mtx_t ports_snapshot_mtx; -erts_smp_atomic_t erts_dead_ports_ptr; /* To store dying ports during snapshot */ - -void -erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) -{ - erts_smp_spin_lock(&make_ref_lock); - - reference0++; - if (reference0 >= MAX_REFERENCE) { - reference0 = 0; - reference1++; - if (reference1 == 0) { - reference2++; - } - } - - ref[0] = reference0; - ref[1] = reference1; - ref[2] = reference2; - - erts_smp_spin_unlock(&make_ref_lock); -} - -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) -{ - Eterm* hp = buffer; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; - - erts_make_ref_in_array(ref); - write_ref_thing(hp, ref[0], ref[1], ref[2]); - return make_internal_ref(hp); -} - -Eterm erts_make_ref(Process *p) -{ - Eterm* hp; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; - - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); - - hp = HAlloc(p, REF_THING_SIZE); - - erts_make_ref_in_array(ref); - write_ref_thing(hp, ref[0], ref[1], ref[2]); - - return make_internal_ref(hp); -} - -BIF_RETTYPE make_ref_0(BIF_ALIST_0) -{ - return erts_make_ref(BIF_P); -} - -/**********************************************************************/ - /* return the time of day */ BIF_RETTYPE time_0(BIF_ALIST_0) @@ -4607,6 +4560,28 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) break; } #endif + } else if (BIF_ARG_1 == am_time_offset + && ERTS_IS_ATOM_STR("finalize", BIF_ARG_2)) { + ErtsTimeOffsetState res; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + res = erts_finalize_time_offset(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + switch (res) { + case ERTS_TIME_OFFSET_PRELIMINARY: { + DECL_AM(preliminary); + BIF_RET(AM_preliminary); + } + case ERTS_TIME_OFFSET_FINAL: { + DECL_AM(final); + BIF_RET(AM_final); + } + case ERTS_TIME_OFFSET_VOLATILE: { + DECL_AM(volatile); + BIF_RET(AM_volatile); + } + default: + ERTS_INTERNAL_ERROR("Unknown state"); + } } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4758,7 +4733,7 @@ BIF_RETTYPE bump_reductions_1(BIF_ALIST_1) } BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) { - int res = CMP_TERM(BIF_ARG_1,BIF_ARG_2); + Sint res = CMP_TERM(BIF_ARG_1,BIF_ARG_2); /* ensure -1, 0, 1 result */ if (res < 0) { @@ -4894,11 +4869,6 @@ void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, void erts_init_bif(void) { - reference0 = 0; - reference1 = 0; - reference2 = 0; - - erts_smp_spinlock_init(&make_ref_lock, "make_ref"); erts_smp_mtx_init(&ports_snapshot_mtx, "ports_snapshot"); erts_smp_atomic_init_nob(&erts_dead_ports_ptr, (erts_aint_t) NULL); @@ -4915,13 +4885,21 @@ 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); - flush_monitor_message_trap = erts_export_put(am_erlang, - am_flush_monitor_message, - 2); + flush_monitor_messages_trap = erts_export_put(am_erts_internal, + am_flush_monitor_messages, + 3); + + erts_convert_time_unit_trap = erts_export_put(am_erlang, + am_convert_time_unit, + 3); set_cpu_topology_trap = erts_export_put(am_erlang, am_set_cpu_topology, diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 7b69b39511..b877711544 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -20,7 +20,9 @@ #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; #define BIF_RETTYPE Eterm @@ -30,10 +32,12 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS #define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS #define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_4 Process* A__p, Eterm* BIF__ARGS #define BIF_ARG_1 (BIF__ARGS[0]) #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) +#define BIF_ARG_4 (BIF__ARGS[3]) #define ERTS_IS_PROC_OUT_OF_REDS(p) \ ((p)->fcalls > 0 \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 1d0d214e77..eadba3eaff 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -92,6 +92,8 @@ bif erlang:loaded/0 bif erlang:localtime/0 bif erlang:localtime_to_universaltime/2 bif erlang:make_ref/0 +bif erlang:unique_integer/0 +bif erlang:unique_integer/1 bif erlang:md5/1 bif erlang:md5_init/0 bif erlang:md5_update/2 @@ -104,6 +106,13 @@ ubif erlang:node/1 ubif erlang:node/0 bif erlang:nodes/1 bif erlang:now/0 +bif erlang:monotonic_time/0 +bif erlang:monotonic_time/1 +bif erlang:system_time/0 +bif erlang:system_time/1 +bif erlang:time_offset/0 +bif erlang:time_offset/1 +bif erlang:timestamp/0 bif erlang:open_port/2 @@ -157,6 +166,12 @@ bif erts_internal:request_system_task/3 bif erts_internal:check_process_code/2 bif erts_internal:map_to_tuple_keys/1 +bif erts_internal:map_type/1 +bif erts_internal:map_hashmap_children/1 + +bif erts_internal:time_unit/0 + +bif erts_internal:is_system_process/1 # inet_db support bif erlang:port_set_data/2 @@ -201,9 +216,13 @@ 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 @@ -348,6 +367,8 @@ bif os:getenv/0 bif os:getenv/1 bif os:getpid/0 bif os:timestamp/0 +bif os:system_time/0 +bif os:system_time/1 # # Bifs in the erl_ddll module (the module actually does not exist) @@ -613,6 +634,8 @@ bif erlang:fun_info_mfa/1 # bif erlang:get_keys/0 +bif ets:update_counter/4 +bif erts_debug:map_info/1 # # Obsolete diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index de7d370938..a4ea9c59ca 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1577,6 +1577,46 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) return make_big(hp); } +Eterm +erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array) +{ + Uint *headerp; + int i, pot_digits, digits; + + headerp = *hpp; + + pot_digits = digits = 0; + for (i = 0; i < len; i++) { +#if defined(ARCH_32) || HALFWORD_HEAP + Uint low_val = array[i] & ((Uint) 0xffffffff); + Uint high_val = (array[i] >> 32) & ((Uint) 0xffffffff); + BIG_DIGIT(headerp, pot_digits) = low_val; + pot_digits++; + if (low_val) + digits = pot_digits; + BIG_DIGIT(headerp, pot_digits) = high_val; + pot_digits++; + if (high_val) + digits = pot_digits; +#else + Uint val = array[i]; + BIG_DIGIT(headerp, pot_digits) = val; + pot_digits++; + if (val) + digits = pot_digits; +#endif + } + + if (neg) + *headerp = make_neg_bignum_header(digits); + else + *headerp = make_pos_bignum_header(digits); + + *hpp = headerp + 1 + digits; + + return make_big(headerp); +} + /* ** Convert a bignum to a double float */ @@ -1900,6 +1940,8 @@ Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r) *rwp = d; rwp++; } + if (rsz > BIG_ARITY_MAX) + return NIL; if (xsgn) { *r = make_neg_bignum_header(rsz); } diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index da31876d75..4e4611de16 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -104,6 +104,9 @@ typedef Uint dsize_t; /* Vector size type */ : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(Uint64)(X))) #define ERTS_UINT64_HEAP_SIZE(X) \ (IS_USMALL(0, (X)) ? 0 : ERTS_UINT64_BIG_HEAP_SIZE__((X))) +#define ERTS_MAX_SINT64_HEAP_SIZE (1 + 2) +#define ERTS_MAX_UINT64_HEAP_SIZE (1 + 2) +#define ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(LEN) (2*(LEN)+1) #else @@ -111,6 +114,9 @@ typedef Uint dsize_t; /* Vector size type */ (IS_SSMALL((X)) ? 0 : (1 + 1)) #define ERTS_UINT64_HEAP_SIZE(X) \ (IS_USMALL(0, (X)) ? 0 : (1 + 1)) +#define ERTS_MAX_SINT64_HEAP_SIZE (1 + 1) +#define ERTS_MAX_UINT64_HEAP_SIZE (1 + 1) +#define ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(LEN) ((LEN)+1) #endif @@ -156,6 +162,7 @@ int term_to_Uint(Eterm, Uint*); int term_to_UWord(Eterm, UWord*); int term_to_Sint(Eterm, Sint*); #if HAVE_INT64 +Eterm erts_uint64_array_to_big(Uint **, int, int, Uint64 *); int term_to_Uint64(Eterm, Uint64*); int term_to_Sint64(Eterm, Sint64*); #endif diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 41765dad12..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; @@ -181,7 +181,6 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext) ASSERT(is_node_name_atom(mon->pid)); erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name, mon->pid, mon->ref); - erts_print(to, to_arg,"}"); } else if (is_atom(mon->name)){ /* local by name */ erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name, erts_this_dist_entry->sysname, mon->ref); @@ -228,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) { @@ -662,7 +661,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) { #ifdef ERTS_SMP ErtsThrPrgrData tpd_buf; /* in case we aren't a managed thread... */ - int bc; #endif int fd; size_t envsz; @@ -682,7 +680,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) /* Order all managed threads to block, this has to be done first to guarantee that this is the only thread to generate crash dump. */ - bc = erts_thr_progress_fatal_error_block(&tpd_buf); + erts_thr_progress_fatal_error_block(&tpd_buf); #ifdef ERTS_THR_HAVE_SIG_FUNCS /* diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index 4344558348..d925709bd0 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -130,7 +130,7 @@ int erts_try_seize_code_write_permission(Process* c_p) ASSERT(code_writing_process != c_p); qitem = erts_alloc(ERTS_ALC_T_CODE_IX_LOCK_Q, sizeof(*qitem)); qitem->p = c_p; - erts_smp_proc_inc_refc(c_p); + erts_proc_inc_refc(c_p); qitem->next = code_write_queue; code_write_queue = qitem; erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); @@ -151,7 +151,7 @@ void erts_release_code_write_permission(void) } erts_smp_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS); code_write_queue = qitem->next; - erts_smp_proc_dec_refc(qitem->p); + erts_proc_dec_refc(qitem->p); erts_free(ERTS_ALC_T_CODE_IX_LOCK_Q, qitem); } code_writing_process = NULL; diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 0010f6a440..850606dd86 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -127,6 +127,52 @@ Uint size_object(Eterm obj) obj = *bptr; break; } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : + { + Uint n; + flatmap_t *mp; + mp = (flatmap_t*)flatmap_val_rel(obj,base); + ptr = (Eterm *)mp; + n = flatmap_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + } + goto pop_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + { + Eterm *head; + Uint sz; + head = hashmap_val_rel(obj, base); + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + sz + header_arity(hdr); + head += 1 + header_arity(hdr); + + if (sz == 0) { + goto pop_next; + } + while(sz-- > 1) { + obj = head[sz]; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + } + obj = head[0]; + } + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + break; case SUB_BINARY_SUBTAG: { Eterm real_bin; @@ -154,25 +200,7 @@ Uint size_object(Eterm obj) goto pop_next; } break; - case MAP_SUBTAG: - { - Uint n; - map_t *mp; - mp = (map_t*)map_val_rel(obj,base); - ptr = (Eterm *)mp; - n = map_get_size(mp) + 1; - sum += n + 2; - ptr += 2; /* hdr + size words */ - while (n--) { - obj = *ptr++; - if (!IS_CONST(obj)) { - ESTACK_PUSH(s, obj); - } - } - goto pop_next; - } - break; - case BIN_MATCHSTATE_SUBTAG: + case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_object: matchstate term not allowed"); default: @@ -340,15 +368,6 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } break; - case MAP_SUBTAG: - { - i = map_get_size(objp) + 3; - *argp = make_map_rel(htop, dst_base); - while (i--) { - *htop++ = *objp++; - } - } - break; case REFC_BINARY_SUBTAG: { ProcBin* pb; @@ -459,7 +478,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) { ExternalThing *etp = (ExternalThing *) htop; - i = thing_arityval(hdr) + 1; + i = thing_arityval(hdr) + 1; tp = htop; while (i--) { @@ -473,6 +492,28 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) *argp = make_external_rel(tp, dst_base); } break; + case MAP_SUBTAG: + tp = htop; + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : + i = flatmap_get_size(objp) + 3; + *argp = make_flatmap_rel(htop, dst_base); + while (i--) { + *htop++ = *objp++; + } + break; + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + *htop++ = *objp++; + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr)); + while (i--) { *htop++ = *objp++; } + *argp = make_hashmap_rel(tp, dst_base); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + break; case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "copy_struct: matchstate term not allowed"); @@ -567,11 +608,6 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) erts_refc_inc(&funp->fe->refc, 2); } goto off_heap_common; - - case MAP_SUBTAG: - *hp++ = *tp++; - sz--; - break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: @@ -607,7 +643,6 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } *hpp = hp; - return res; } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index bfecac1612..142fcb3c00 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -388,11 +388,7 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) Eterm tup; Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks); tup = TUPLE2(hp, am_nodedown, name); - erts_queue_message(rp, &rp_locks, bp, tup, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, tup, NIL); } erts_smp_proc_unlock(rp, rp_locks); } @@ -712,7 +708,7 @@ void erts_dsend_context_dtor(Binary* ctx_bin) ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); switch (ctx->dss.phase) { case ERTS_DSIG_SEND_PHASE_MSG_SIZE: - DESTROY_SAVED_ESTACK(&ctx->dss.u.sc.estack); + DESTROY_SAVED_WSTACK(&ctx->dss.u.sc.wstack); break; case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack); @@ -1800,7 +1796,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size); if (is_value(ctx->msg)) { - ctx->u.sc.estack.start = NULL; + ctx->u.sc.wstack.wstart = NULL; ctx->u.sc.flags = ctx->flags; ctx->u.sc.level = 0; ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; @@ -3325,11 +3321,7 @@ send_nodes_mon_msg(Process *rp, } ASSERT(hend == hp); - erts_queue_message(rp, rp_locksp, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, rp_locksp, bp, msg, NIL); } static void diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 2a2ba0c83f..cd2cc0ef4a 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -282,7 +282,7 @@ typedef struct TTBSizeContext_ { int level; Uint result; Eterm obj; - ErtsEStack estack; + ErtsWStack wstack; } TTBSizeContext; typedef struct TTBEncodeContext_ { diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index f2bceff4eb..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 @@ -3180,17 +3189,13 @@ reply_alloc_info(void *vair) HRelease(rp, hp_end, hp); } - erts_queue_message(rp, &rp_locks, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, msg, NIL); if (air->req_sched == sched_id) 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); @@ -3264,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 61def65235..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 @@ -269,6 +273,7 @@ type BUSY_CALLER_TAB SHORT_LIVED SYSTEM busy_caller_table type BUSY_CALLER SHORT_LIVED SYSTEM busy_caller type PROC_SYS_TSK SHORT_LIVED PROCESSES proc_sys_task type PROC_SYS_TSK_QS SHORT_LIVED PROCESSES proc_sys_task_queues +type NEW_TIME_OFFSET SHORT_LIVED SYSTEM new_time_offset +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; @@ -323,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 @@ -416,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_binary.c b/erts/emulator/beam/erl_bif_binary.c index bd0d7c71cc..934904d58e 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -38,6 +38,7 @@ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" +#include "erl_bif_unique.h" /* diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 56cd2ba04f..7b35edc9c4 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -45,6 +45,7 @@ #include "big.h" #include "dist.h" #include "erl_version.h" +#include "erl_bif_unique.h" #include "dtrace-wrapper.h" #ifdef ERTS_SMP @@ -1730,11 +1731,7 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, hp += REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } - erts_queue_message(proc, &rp_locks, bp, mess, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(proc, &rp_locks, bp, mess, am_undefined); erts_smp_proc_unlock(proc, rp_locks); ERTS_SMP_CHK_NO_PROC_LOCKS; } diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c index bbd8aa31d9..6226ec2d04 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -459,23 +459,25 @@ Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live) Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live) { Eterm arg = reg[live]; - if (is_map(arg)) { - map_t *mp = (map_t*)map_val(arg); - Uint size = map_get_size(mp); - if (IS_USMALL(0, size)) { - return make_small(size); - } else { - Eterm* hp; - if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { - erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); - } - hp = p->htop; - p->htop += BIG_UINT_HEAP_SIZE; - return uint_to_big(size, hp); - } - } else { - BIF_ERROR(p, BADARG); - } + if (is_flatmap(arg)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(arg); + return make_small(flatmap_get_size(mp)); + } else if (is_hashmap(arg)) { + Eterm* hp; + Uint size; + size = hashmap_size(arg); + if (IS_USMALL(0, size)) { + return make_small(size); + } + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(size, hp); + } + p->fvalue = arg; + BIF_ERROR(p, BADMAP); } Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index d750e34be3..f74aea80a7 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -42,6 +42,7 @@ #include "erl_cpu_topology.h" #include "erl_async.h" #include "erl_thr_progress.h" +#include "erl_bif_unique.h" #define ERTS_PTAB_WANT_DEBUG_FUNCS__ #include "erl_ptab.h" #ifdef HIPE @@ -540,6 +541,7 @@ pi_locks(Eterm info) switch (info) { case am_status: case am_priority: + case am_trap_exit: return ERTS_PROC_LOCK_STATUS; case am_links: case am_monitors: @@ -592,7 +594,7 @@ static Eterm pi_args[] = { am_min_bin_vheap_size, am_current_location, am_current_stacktrace, -}; +}; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -1052,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; @@ -2102,6 +2104,50 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_opt); #endif BIF_RET(res); + } else if (BIF_ARG_1 == am_time_offset) { + switch (erts_time_offset_state()) { + case ERTS_TIME_OFFSET_PRELIMINARY: { + ERTS_DECL_AM(preliminary); + BIF_RET(AM_preliminary); + } + case ERTS_TIME_OFFSET_FINAL: { + ERTS_DECL_AM(final); + BIF_RET(AM_final); + } + case ERTS_TIME_OFFSET_VOLATILE: { + ERTS_DECL_AM(volatile); + BIF_RET(AM_volatile); + } + default: + ERTS_INTERNAL_ERROR("Invalid time offset state"); + } + } else if (ERTS_IS_ATOM_STR("os_monotonic_time_source", BIF_ARG_1)) { + BIF_RET(erts_monotonic_time_source(BIF_P)); + } else if (ERTS_IS_ATOM_STR("os_system_time_source", BIF_ARG_1)) { + BIF_RET(erts_system_time_source(BIF_P)); + } else if (ERTS_IS_ATOM_STR("time_correction", BIF_ARG_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: { + ERTS_DECL_AM(no_time_warp); + BIF_RET(AM_no_time_warp); + } + case ERTS_SINGLE_TIME_WARP_MODE: { + ERTS_DECL_AM(single_time_warp); + BIF_RET(AM_single_time_warp); + } + case ERTS_MULTI_TIME_WARP_MODE: { + ERTS_DECL_AM(multi_time_warp); + BIF_RET(AM_multi_time_warp); + } + default: + ERTS_INTERNAL_ERROR("Invalid time warp mode"); + } } else if (BIF_ARG_1 == am_allocated_areas) { res = erts_allocated_areas(NULL, NULL, BIF_P); BIF_RET(res); @@ -2703,9 +2749,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(make_small(erts_db_get_max_tabs())); } else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { - BIF_RET(erts_disable_tolerant_timeofday - ? am_disabled - : am_enabled); + if (erts_has_time_correction() + && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) { + BIF_RET(am_enabled); + } + BIF_RET(am_disabled); } else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) { BIF_RET(erts_eager_check_io ? am_true : am_false); @@ -3403,6 +3451,29 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) { BIF_RET(erts_mmap_debug_info(BIF_P)); } + else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) { + BIF_RET(erts_debug_get_unique_monotonic_integer_state(BIF_P)); + } + else if (ERTS_IS_ATOM_STR("min_unique_monotonic_integer", BIF_ARG_1)) { + Sint64 value = erts_get_min_unique_monotonic_integer(); + if (IS_SSMALL(value)) + BIF_RET(make_small(value)); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(value); + Eterm *hp = HAlloc(BIF_P, hsz); + BIF_RET(erts_sint64_to_big(value, &hp)); + } + } + else if (ERTS_IS_ATOM_STR("min_unique_integer", BIF_ARG_1)) { + Sint64 value = erts_get_min_unique_integer(); + if (IS_SSMALL(value)) + BIF_RET(make_small(value)); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(value); + Eterm *hp = HAlloc(BIF_P, hsz); + BIF_RET(erts_sint64_to_big(value, &hp)); + } + } } else if (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); @@ -3597,6 +3668,58 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(erts_debug_reader_groups_map(BIF_P, (int) groups)); } + else if (ERTS_IS_ATOM_STR("internal_hash", tp[1])) { + Uint hash = (Uint) make_internal_hash(tp[2]); + Uint hsz = 0; + Eterm* hp; + erts_bld_uint(NULL, &hsz, hash); + hp = HAlloc(BIF_P,hsz); + return erts_bld_uint(&hp, NULL, hash); + } + else if (ERTS_IS_ATOM_STR("atom", tp[1])) { + Uint ix; + if (!term_to_Uint(tp[2], &ix)) + BIF_ERROR(BIF_P, BADARG); + while (ix >= atom_table_size()) { + char tmp[20]; + erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size()); + erts_atom_put((byte *) tmp, strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1); + } + return make_atom(ix); + } + + break; + } + case 3: { + if (ERTS_IS_ATOM_STR("check_time_config", tp[1])) { + int res, time_correction; + ErtsTimeWarpMode time_warp_mode; + if (tp[2] == am_true) + time_correction = !0; + else if (tp[2] == am_false) + time_correction = 0; + else + break; + if (ERTS_IS_ATOM_STR("no_time_warp", tp[3])) + time_warp_mode = ERTS_NO_TIME_WARP_MODE; + else if (ERTS_IS_ATOM_STR("single_time_warp", tp[3])) + time_warp_mode = ERTS_SINGLE_TIME_WARP_MODE; + else if (ERTS_IS_ATOM_STR("multi_time_warp", tp[3])) + time_warp_mode = ERTS_MULTI_TIME_WARP_MODE; + else + break; + res = erts_check_time_adj_support(time_correction, + time_warp_mode); + BIF_RET(res ? am_true : am_false); + } + else if (ERTS_IS_ATOM_STR("make_unique_integer", tp[1])) { + Eterm res = erts_debug_make_unique_integer(BIF_P, + tp[2], + tp[3]); + if (is_non_value(res)) + break; + BIF_RET(res); + } break; } default: @@ -3606,8 +3729,40 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } +BIF_RETTYPE erts_internal_is_system_process_1(BIF_ALIST_1) +{ + if (is_internal_pid(BIF_ARG_1)) { + Process *rp = erts_proc_lookup(BIF_ARG_1); + if (rp && (rp->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) + BIF_RET(am_true); + BIF_RET(am_false); + } + + if (is_external_pid(BIF_ARG_1) + && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { + BIF_RET(am_false); + } + + BIF_ERROR(BIF_P, BADARG); +} + + static erts_smp_atomic_t hipe_test_reschedule_flag; +#if defined(VALGRIND) && defined(__GNUC__) +/* Force noinline for valgrind suppression */ +static void broken_halt_test(Eterm bif_arg_2) __attribute__((noinline)); +#endif + +static void broken_halt_test(Eterm bif_arg_2) +{ + /* Ugly ugly code used by bif_SUITE:erlang_halt/1 */ +#if defined(ERTS_HAVE_TRY_CATCH) + erts_get_scheduler_data()->run_queue = NULL; +#endif + erl_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2); +} + BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) { @@ -3901,12 +4056,12 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } } else if (ERTS_IS_ATOM_STR("broken_halt", BIF_ARG_1)) { - /* Ugly ugly code used by bif_SUITE:erlang_halt/1 */ -#if defined(ERTS_HAVE_TRY_CATCH) - erts_get_scheduler_data()->run_queue = NULL; -#endif - erl_exit(ERTS_DUMP_EXIT, "%T", BIF_ARG_2); + broken_halt_test(BIF_ARG_2); } + else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) { + int res = erts_debug_set_unique_monotonic_integer_state(BIF_ARG_2); + BIF_RET(res ? am_true : am_false); + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 820ed2385d..e006d57124 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -390,7 +390,7 @@ keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List) Eterm *tuple_ptr = tuple_val(term); if (pos <= arityval(*tuple_ptr)) { Eterm element = tuple_ptr[pos]; - if (CMP(Key, element) == 0) { + if (CMP_EQ(Key, element)) { return term; } } diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c deleted file mode 100644 index 03ac97283c..0000000000 --- a/erts/emulator/beam/erl_bif_timer.c +++ /dev/null @@ -1,705 +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" - -/**************************************************************************** -** 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 -#ifdef USE_VM_PROBES - , NIL -#endif - ); - 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)); - btm->tm.active = 0; /* MUST be initalized */ - erts_set_timer(&btm->tm, - (ErlTimeoutProc) bif_timer_timeout, - (ErlCancelProc) bif_timer_cleanup, - (void *) btm, - timeout); - return ref; -} - -/* send_after(Time, Pid, Message) -> Ref */ -BIF_RETTYPE 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); - } -} - -/* start_timer(Time, Pid, Message) -> Ref */ -BIF_RETTYPE 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); - } -} - -/* cancel_timer(Ref) -> false | RemainingTime */ -BIF_RETTYPE 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); -} - -/* read_timer(Ref) -> false | RemainingTime */ -BIF_RETTYPE 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(); -} - -void erts_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); - } - } -} diff --git a/erts/emulator/beam/erl_bif_timer.h b/erts/emulator/beam/erl_bif_timer.h deleted file mode 100644 index 1197c176f5..0000000000 --- a/erts/emulator/beam/erl_bif_timer.h +++ /dev/null @@ -1,36 +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); -#endif diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index f5e582b1c5..13e0160648 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -38,6 +38,7 @@ #include "beam_bp.h" #include "erl_binary.h" #include "erl_thr_progress.h" +#include "erl_bif_unique.h" #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) @@ -358,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)); } @@ -392,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_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c new file mode 100644 index 0000000000..57b0bab72f --- /dev/null +++ b/erts/emulator/beam/erl_bif_unique.c @@ -0,0 +1,556 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 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 + * 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 "sys.h" +#include "erl_vm.h" +#include "erl_alloc.h" +#include "export.h" +#include "bif.h" +#include "erl_bif_unique.h" + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Reference * +\* */ + +static union { + erts_atomic64_t count; + char align__[ERTS_CACHE_LINE_SIZE]; +} global_reference erts_align_attribute(ERTS_CACHE_LINE_SIZE); + + +/* + * ref[0] indicate thread creating reference as follows: + * + * - ref[0] == 0 => Non-scheduler thread; + * - else; ref[0] <= erts_no_schedulers => + * ordinary scheduler with id == ref[0]; + * - else; ref[0] <= erts_no_schedulers + * + erts_no_dirty_cpu_schedulers => + * dirty cpu scheduler with id == 'ref[0] - erts_no_schedulers'; + * - else => + * dirty io scheduler with id == 'ref[0] + * - erts_no_schedulers + * - erts_no_dirty_cpu_schedulers' + */ + +#ifdef DEBUG +static Uint32 max_thr_id; +#endif + +static void +init_reference(void) +{ +#ifdef DEBUG + max_thr_id = (Uint32) erts_no_schedulers; +#ifdef ERTS_DIRTY_SCHEDULERS + max_thr_id += (Uint32) erts_no_dirty_cpu_schedulers; + max_thr_id += (Uint32) erts_no_dirty_io_schedulers; +#endif +#endif + erts_atomic64_init_nob(&global_reference.count, 0); +} + +static ERTS_INLINE void +global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + Uint64 value; + + value = (Uint64) erts_atomic64_inc_read_mb(&global_reference.count); + + erts_set_ref_numbers(ref, thr_id, value); +} + +static ERTS_INLINE void +make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) + erts_sched_make_ref_in_array(esdp, ref); + else + global_make_ref_in_array(0, ref); +} + +void +erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + make_ref_in_array(ref); +} + +Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) +{ + Eterm* hp = buffer; + Uint32 ref[ERTS_MAX_REF_NUMBERS]; + + make_ref_in_array(ref); + write_ref_thing(hp, ref[0], ref[1], ref[2]); + return make_internal_ref(hp); +} + +Eterm erts_make_ref(Process *c_p) +{ + Eterm* hp; + Uint32 ref[ERTS_MAX_REF_NUMBERS]; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); + + hp = HAlloc(c_p, REF_THING_SIZE); + + make_ref_in_array(ref); + write_ref_thing(hp, ref[0], ref[1], ref[2]); + + return make_internal_ref(hp); +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Unique Integer * +\* */ + +static struct { + union { + struct { + int left_shift; + int right_shift; + Uint64 mask; + Uint64 val0_max; + } o; + char align__[ERTS_CACHE_LINE_SIZE]; + } r; + union { + erts_atomic64_t val1; + char align__[ERTS_CACHE_LINE_SIZE]; + } w; +} unique_data erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +static void +init_unique_integer(void) +{ + int bits; + unique_data.r.o.val0_max = (Uint64) erts_no_schedulers; +#ifdef ERTS_DIRTY_SCHEDULERS + unique_data.r.o.val0_max += (Uint64) erts_no_dirty_cpu_schedulers; + unique_data.r.o.val0_max += (Uint64) erts_no_dirty_io_schedulers; +#endif + bits = erts_fit_in_bits_int64(unique_data.r.o.val0_max); + unique_data.r.o.left_shift = bits; + unique_data.r.o.right_shift = 64 - bits; + unique_data.r.o.mask = (((Uint64) 1) << bits) - 1; + erts_atomic64_init_nob(&unique_data.w.val1, -1); +} + +#define ERTS_MAX_UNIQUE_INT_HEAP_SIZE ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(2) + +static ERTS_INLINE Eterm +bld_unique_integer_term(Eterm **hpp, Uint *szp, + Uint64 val0, Uint64 val1, + int positive) +{ + Uint hsz; + Uint64 unique_val[2]; + + unique_val[0] = ((Uint64) val0); + unique_val[0] |= ((Uint64) val1) << unique_data.r.o.left_shift; + unique_val[1] = ((Uint64) val1) >> unique_data.r.o.right_shift; + unique_val[1] &= unique_data.r.o.mask; + + if (positive) { + unique_val[0]++; + if (unique_val[0] == 0) + unique_val[1]++; + } + else { + ASSERT(MIN_SMALL < 0); + if (unique_val[1] == 0 + && unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) { + Sint64 s_unique_val = (Sint64) unique_val[0]; + s_unique_val += MIN_SMALL; + ASSERT(MIN_SMALL <= s_unique_val && s_unique_val < 0); + if (szp) + *szp = 0; + if (!hpp) + return THE_NON_VALUE; + return make_small((Sint) s_unique_val); + } + if (unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) { + ASSERT(unique_val[1] != 0); + unique_val[1] -= 1; + } + unique_val[0] += MIN_SMALL; + } + + if (!unique_val[1]) { + if (unique_val[0] <= MAX_SMALL) { + if (szp) + *szp = 0; + if (!hpp) + return THE_NON_VALUE; + return make_small((Uint) unique_val[0]); + } + + if (szp) + *szp = ERTS_UINT64_HEAP_SIZE(unique_val[0]); + if (!hpp) + return THE_NON_VALUE; + return erts_uint64_to_big(unique_val[0], hpp); + } + else { + Eterm tmp, *tmp_hp, res; + DeclareTmpHeapNoproc(local_heap, 2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE); + + UseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE); + + tmp_hp = local_heap; + + tmp = erts_uint64_array_to_big(&tmp_hp, 0, 2, unique_val); + ASSERT(is_big(tmp)); + + hsz = big_arity(tmp) + 1; + + ASSERT(hsz <= ERTS_MAX_UNIQUE_INT_HEAP_SIZE); + + if (szp) + *szp = hsz; + + if (!hpp) + res = THE_NON_VALUE; + else { + int hix; + Eterm *hp = *hpp; + tmp_hp = big_val(tmp); + for (hix = 0; hix < hsz; hix++) + hp[hix] = tmp_hp[hix]; + + *hpp = hp + hsz; + res = make_big(hp); + } + + UnUseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE); + + return res; + } +} + +static ERTS_INLINE Eterm unique_integer_bif(Process *c_p, int positive) +{ + ErtsSchedulerData *esdp; + Uint64 thr_id, unique; + Uint hsz; + Eterm *hp; + + esdp = ERTS_PROC_GET_SCHDATA(c_p); + thr_id = (Uint64) esdp->thr_id; + unique = esdp->unique++; + bld_unique_integer_term(NULL, &hsz, thr_id, unique, positive); + hp = hsz ? HAlloc(c_p, hsz) : NULL; + return bld_unique_integer_term(&hp, NULL, thr_id, unique, positive); +} + +Uint +erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +{ + Uint sz; + bld_unique_integer_term(NULL, &sz, val[0], val[1], 0); + return sz; +} + +Eterm +erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +{ + return bld_unique_integer_term(hpp, NULL, val[0], val[1], 0); +} + +void +erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) { + val[0] = (Uint64) esdp->thr_id; + val[1] = esdp->unique++; + } + else { + val[0] = (Uint64) 0; + val[1] = (Uint64) erts_atomic64_inc_read_nob(&unique_data.w.val1); + } +} + + +Sint64 +erts_get_min_unique_integer(void) +{ + return (Sint64) MIN_SMALL; +} + +/* --- Debug --- */ + +Eterm +erts_debug_make_unique_integer(Process *c_p, Eterm etval0, Eterm etval1) +{ + Uint64 val0, val1; + Uint hsz; + Eterm res, *hp, *end_hp; + + if (!term_to_Uint64(etval0, &val0)) + return THE_NON_VALUE; + + if (!term_to_Uint64(etval1, &val1)) + return THE_NON_VALUE; + + bld_unique_integer_term(NULL, &hsz, val0, val1, 0); + + hp = HAlloc(c_p, hsz); + end_hp = hp + hsz; + + res = bld_unique_integer_term(&hp, NULL, val0, val1, 0); + if (hp != end_hp) + ERTS_INTERNAL_ERROR("Heap allocation error"); + + return res; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Strict Monotonic Counter * +\* */ + +static struct { + union { + erts_atomic64_t value; + char align__[ERTS_CACHE_LINE_SIZE]; + } w; +} raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +#if defined(ARCH_32) || HALFWORD_HEAP +# define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN +#else +# define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL +#endif + +static void +init_unique_monotonic_integer(void) +{ + erts_atomic64_init_nob(&raw_unique_monotonic_integer.w.value, + (erts_aint64_t) -1); +} + +static ERTS_INLINE Uint64 +get_raw_unique_monotonic_integer(void) +{ + return (Uint64) erts_atomic64_inc_read_mb(&raw_unique_monotonic_integer.w.value); +} + +static ERTS_INLINE Uint +get_unique_monotonic_integer_heap_size(Uint64 raw, int positive) +{ + if (positive) { + Uint64 value = raw+1; + return ERTS_UINT64_HEAP_SIZE(value); + } + else { + Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET; + if (IS_SSMALL(value)) + return 0; +#if defined(ARCH_32) || HALFWORD_HEAP + return ERTS_SINT64_HEAP_SIZE(value); +#else + return ERTS_UINT64_HEAP_SIZE((Uint64) value); +#endif + } +} + +static ERTS_INLINE Eterm +make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positive) +{ + Eterm res; +#ifdef DEBUG + Eterm *end_hp = hp + hsz; +#endif + + if (positive) { + Uint64 value = raw+1; + res = hsz ? erts_uint64_to_big(value, &hp) : make_small(value); + } + else { + Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET; + if (hsz == 0) + res = make_small(value); + else { +#if defined(ARCH_32) || HALFWORD_HEAP + res = erts_sint64_to_big(value, &hp); +#else + res = erts_uint64_to_big((Uint64) value, &hp); +#endif + } + } + + ASSERT(end_hp == hp); + + return res; +} + +static ERTS_INLINE Eterm +unique_monotonic_integer_bif(Process *c_p, int positive) +{ + Uint64 raw; + Uint hsz; + Eterm *hp; + + raw = get_raw_unique_monotonic_integer(); + hsz = get_unique_monotonic_integer_heap_size(raw, positive); + hp = hsz ? HAlloc(c_p, hsz) : NULL; + return make_unique_monotonic_integer_value(hp, hsz, raw, positive); +} + +Sint64 +erts_raw_get_unique_monotonic_integer(void) +{ + return get_raw_unique_monotonic_integer(); +} + +Uint +erts_raw_unique_monotonic_integer_heap_size(Sint64 raw) +{ + return get_unique_monotonic_integer_heap_size(raw, 0); +} + +Eterm +erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw) +{ + Uint hsz = get_unique_monotonic_integer_heap_size(raw, 0); + Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, 0); + *hpp += hsz; + return res; +} + +Sint64 +erts_get_min_unique_monotonic_integer(void) +{ + return ERTS_UNIQUE_MONOTONIC_OFFSET; +} + +/* --- Debug --- */ + +int +erts_debug_set_unique_monotonic_integer_state(Eterm et_value) +{ + Sint64 value; + + if (!term_to_Sint64(et_value, &value)) { + Uint64 uvalue; + if (!term_to_Uint64(et_value, &uvalue)) + return 0; + value = (Sint64) uvalue; + } + + erts_atomic64_set_mb(&raw_unique_monotonic_integer.w.value, + (erts_aint64_t) value); + return 1; +} + +Eterm +erts_debug_get_unique_monotonic_integer_state(Process *c_p) +{ + Uint64 value; + Eterm hsz, *hp; + + value = (Uint64) erts_atomic64_read_mb(&raw_unique_monotonic_integer.w.value); + + if (IS_USMALL(0, value)) + return make_small(value); + hsz = ERTS_UINT64_HEAP_SIZE(value); + hp = HAlloc(c_p, hsz); + return erts_uint64_to_big(value, &hp); +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Initilazation * +\* */ + +void +erts_bif_unique_init(void) +{ + init_reference(); + init_unique_monotonic_integer(); + init_unique_integer(); +} + +void +erts_sched_bif_unique_init(ErtsSchedulerData *esdp) +{ + esdp->unique = (Uint64) 0; + esdp->ref = (Uint64) 0; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * The BIFs * +\* */ + + +BIF_RETTYPE make_ref_0(BIF_ALIST_0) +{ + BIF_RETTYPE res; + Eterm* hp; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); + + hp = HAlloc(BIF_P, REF_THING_SIZE); + + res = erts_sched_make_ref_in_buffer(ERTS_PROC_GET_SCHDATA(BIF_P), hp); + + BIF_RET(res); +} + +BIF_RETTYPE unique_integer_0(BIF_ALIST_0) +{ + BIF_RET(unique_integer_bif(BIF_P, 0)); +} + +BIF_RETTYPE unique_integer_1(BIF_ALIST_1) +{ + Eterm modlist = BIF_ARG_1; + int monotonic = 0; + int positive = 0; + BIF_RETTYPE res; + + while (is_list(modlist)) { + Eterm *consp = list_val(modlist); + switch (CAR(consp)) { + case am_monotonic: + monotonic = 1; + break; + case am_positive: + positive = 1; + break; + default: + BIF_ERROR(BIF_P, BADARG); + } + modlist = CDR(consp); + } + + if (is_not_nil(modlist)) + BIF_ERROR(BIF_P, BADARG); + + if (monotonic) + res = unique_monotonic_integer_bif(BIF_P, positive); + else + res = unique_integer_bif(BIF_P, positive); + + BIF_RET(res); +} diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h new file mode 100644 index 0000000000..cd001172a1 --- /dev/null +++ b/erts/emulator/beam/erl_bif_unique.h @@ -0,0 +1,131 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 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 + * 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 ERTS_BIF_UNIQUE_H__ +#define ERTS_BIF_UNIQUE_H__ + +#include "erl_process.h" +#include "big.h" + +void erts_bif_unique_init(void); +void erts_sched_bif_unique_init(ErtsSchedulerData *esdp); + +/* reference */ +Eterm erts_make_ref(Process *); +Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]); +void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); + +/* strict monotonic counter */ + +#define ERTS_MAX_UNIQUE_MONOTONIC_INTEGER_HEAP_SIZE ERTS_MAX_UINT64_HEAP_SIZE + +/* + * Note that a raw value is an intermediate value that + * not necessarily correspond to the end result. + */ +Sint64 erts_raw_get_unique_monotonic_integer(void); +Uint erts_raw_unique_monotonic_integer_heap_size(Sint64 raw); +Eterm erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw); + +Sint64 erts_get_min_unique_monotonic_integer(void); + +int erts_debug_set_unique_monotonic_integer_state(Eterm et_value); +Eterm erts_debug_get_unique_monotonic_integer_state(Process *c_p); + +/* unique integer */ +#define ERTS_UNIQUE_INT_RAW_VALUES 2 +#define ERTS_MAX_UNIQUE_INT_HEAP_SIZE ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(2) + +Uint erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); +Eterm erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); +void erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); +Sint64 erts_get_min_unique_integer(void); + +Eterm erts_debug_make_unique_integer(Process *c_p, + Eterm etval0, + Eterm etval1); + + +ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], + Uint32 thr_id, Uint64 value); +ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_MAX_REF_NUMBERS]); +ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, + Eterm buffer[REF_THING_SIZE]); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], Uint32 thr_id, Uint64 value) +{ + /* + * We cannot use thread id in the first 18-bit word since + * the hash/phash/phash2 BIFs only hash on this word. If + * we did, we would get really poor hash values. Instead + * we have to shuffle the bits a bit. + */ + ASSERT(thr_id == (thr_id & ((Uint32) 0x3ffff))); + ref[0] = (Uint32) (value & ((Uint64) 0x3ffff)); + ref[1] = (((Uint32) (value & ((Uint64) 0xfffc0000))) + | (thr_id & ((Uint32) 0x3ffff))); + ref[2] = (Uint32) ((value >> 32) & ((Uint64) 0xffffffff)); +} + +ERTS_GLB_INLINE Uint32 +erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + return ref[1] & ((Uint32) 0x3ffff); +} + +ERTS_GLB_INLINE Uint64 +erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + return (((((Uint64) ref[2]) & ((Uint64) 0xffffffff)) << 32) + | (((Uint64) ref[1]) & ((Uint64) 0xfffc0000)) + | (((Uint64) ref[0]) & ((Uint64) 0x3ffff))); +} + +ERTS_GLB_INLINE void +erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + Uint64 value; + + ASSERT(esdp); + value = esdp->ref++; + erts_set_ref_numbers(ref, (Uint32) esdp->thr_id, value); +} + +ERTS_GLB_INLINE Eterm +erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, + Eterm buffer[REF_THING_SIZE]) +{ + Eterm* hp = buffer; + Uint32 ref[ERTS_MAX_REF_NUMBERS]; + + erts_sched_make_ref_in_array(esdp, ref); + write_ref_thing(hp, ref[0], ref[1], ref[2]); + return make_internal_ref(hp); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_BIF_UNIQUE_H__ */ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 71d31c01aa..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; } @@ -403,7 +424,10 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff words_needed = 1+WSIZE(bytes); hp = HeapOnlyAlloc(p, words_needed); res = bytes_to_big(LSB, bytes, sgn, hp); - if (is_small(res)) { + if (is_nil(res)) { + p->htop = hp; + res = THE_NON_VALUE; + } else if (is_small(res)) { p->htop = hp; } else if ((actual = bignum_header_arity(*hp)+1) < words_needed) { p->htop = hp + actual; @@ -422,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; } @@ -453,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); @@ -506,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; @@ -1592,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); @@ -1651,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; } @@ -1735,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 4806befd99..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; @@ -805,7 +805,7 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3) list = BIF_ARG_3; } - if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) { + if (!tb->common.meth->db_lookup_dbterm(BIF_P, tb, BIF_ARG_2, THE_NON_VALUE, &handle)) { cret = DB_ERROR_BADKEY; goto bail_out; } @@ -844,7 +844,7 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3) } finalize: - tb->common.meth->db_finalize_dbterm(&handle); + tb->common.meth->db_finalize_dbterm(cret, &handle); bail_out: UnUseTmpHeap(2,BIF_P); @@ -863,14 +863,8 @@ bail_out: } } -/* -** update_counter(Tab, Key, Incr) -** update_counter(Tab, Key, {Upop}) -** update_counter(Tab, Key, [{Upop}]) -** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo} -** Returns new value(s) (integer or [integer]) -*/ -BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) +static BIF_RETTYPE +do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4) { DbTable* tb; int cret = DB_ERROR_BADITEM; @@ -880,7 +874,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm* ret_list_currp = NULL; Eterm* ret_list_prevp = NULL; Eterm iter; - DeclareTmpHeap(cell,5,BIF_P); + DeclareTmpHeap(cell, 5, p); Eterm *tuple = cell+2; DbUpdateHandle handle; Uint halloc_size = 0; /* overestimated heap usage */ @@ -888,28 +882,29 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm* hstart; Eterm* hend; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + if ((tb = db_get_table(p, arg1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(p, BADARG); } - UseTmpHeap(5,BIF_P); + UseTmpHeap(5, p); if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) { goto bail_out; } - if (is_integer(BIF_ARG_3)) { /* Incr */ - upop_list = CONS(cell, TUPLE2(tuple, make_small(tb->common.keypos+1), - BIF_ARG_3), NIL); + if (is_integer(arg3)) { /* Incr */ + upop_list = CONS(cell, + TUPLE2(tuple, make_small(tb->common.keypos+1), arg3), + NIL); } - else if (is_tuple(BIF_ARG_3)) { /* {Upop} */ - upop_list = CONS(cell, BIF_ARG_3, NIL); + else if (is_tuple(arg3)) { /* {Upop} */ + upop_list = CONS(cell, arg3, NIL); } else { /* [{Upop}] (probably) */ - upop_list = BIF_ARG_3; + upop_list = arg3; ret_list_prevp = &ret; } - if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) { + if (!tb->common.meth->db_lookup_dbterm(p, tb, arg2, arg4, &handle)) { goto bail_out; /* key not found */ } @@ -982,13 +977,13 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) if (ret_list_prevp) { /* Prepare to return a list */ ret = NIL; halloc_size += list_size; - hstart = HAlloc(BIF_P, halloc_size); + hstart = HAlloc(p, halloc_size); ret_list_currp = hstart; htop = hstart + list_size; hend = hstart + halloc_size; } else { - hstart = htop = HAlloc(BIF_P, halloc_size); + hstart = htop = HAlloc(p, halloc_size); } hend = hstart + halloc_size; @@ -1035,26 +1030,54 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) (is_list(ret) && (list_val(ret)+list_size)==ret_list_currp)); ASSERT(htop <= hend); - HRelease(BIF_P,hend,htop); + HRelease(p, hend, htop); finalize: - tb->common.meth->db_finalize_dbterm(&handle); + tb->common.meth->db_finalize_dbterm(cret, &handle); bail_out: - UnUseTmpHeap(5,BIF_P); + UnUseTmpHeap(5, p); db_unlock(tb, LCK_WRITE_REC); switch (cret) { case DB_ERROR_NONE: BIF_RET(ret); case DB_ERROR_SYSRES: - BIF_ERROR(BIF_P, SYSTEM_LIMIT); + BIF_ERROR(p, SYSTEM_LIMIT); default: - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); break; } } +/* +** update_counter(Tab, Key, Incr) +** update_counter(Tab, Key, Upop) +** update_counter(Tab, Key, [{Upop}]) +** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo} +** Returns new value(s) (integer or [integer]) +*/ +BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) +{ + return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE); +} + +/* +** update_counter(Tab, Key, Incr, Default) +** update_counter(Tab, Key, Upop, Default) +** update_counter(Tab, Key, [{Upop}], Default) +** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo} +** Returns new value(s) (integer or [integer]) +*/ +BIF_RETTYPE ets_update_counter_4(BIF_ALIST_4) +{ + if (is_not_tuple(BIF_ARG_4)) { + BIF_ERROR(BIF_P, BADARG); + } + return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4); +} + + /* ** The put BIF */ @@ -1224,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 @@ -1540,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", @@ -1673,7 +1696,7 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) erts_fprintf(stderr, "ets:delete(%T); Process: %T, initial: %T:%T/%bpu\n", BIF_ARG_1, BIF_P->common.id, - BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]); #endif CHECK_TABLES(); diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index c2157457a0..383ee7c430 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -174,7 +174,7 @@ static ERTS_INLINE void add_fixed_deletion(DbTableHash* tb, int ix) /* optimised version of make_hash (normal case? atomic key) */ #define MAKE_HASH(term) \ ((is_atom(term) ? (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ - make_hash2(term)) % MAX_HASH) + make_internal_hash(term)) % MAX_HASH) #ifdef ERTS_SMP # define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1) @@ -444,8 +444,11 @@ static int db_delete_all_objects_hash(Process* p, DbTable* tbl); #ifdef HARDDEBUG static void db_check_table_hash(DbTableHash *tb); #endif -static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle); -static void db_finalize_dbterm_hash(DbUpdateHandle* handle); +static int +db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj, + DbUpdateHandle* handle); +static void +db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle); static ERTS_INLINE void try_shrink(DbTableHash* tb) { @@ -2468,10 +2471,10 @@ static int alloc_seg(DbTableHash *tb) */ static int free_seg(DbTableHash *tb, int free_records) { - int seg_ix = (tb->nslots >> SEGSZ_EXP) - 1; + const int seg_ix = (tb->nslots >> SEGSZ_EXP) - 1; + struct segment** const segtab = SEGTAB(tb); + struct ext_segment* const top = (struct ext_segment*) segtab[seg_ix]; int bytes; - struct segment** segtab = SEGTAB(tb); - struct ext_segment* top = (struct ext_segment*) segtab[seg_ix]; int nrecords = 0; ASSERT(top != NULL); @@ -2534,7 +2537,7 @@ static int free_seg(DbTableHash *tb, int free_records) (void*)top, bytes); #ifdef DEBUG if (seg_ix > 0) { - if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL; + segtab[seg_ix] = NULL; } else { SET_SEGTAB(tb, NULL); } @@ -2796,59 +2799,129 @@ static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr, return NULL; } -static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle) +static int +db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj, + DbUpdateHandle* handle) { DbTableHash *tb = &tbl->hash; - HashDbTerm* b; - HashDbTerm** prevp; - int ix; HashValue hval; + HashDbTerm **bp, *b; erts_smp_rwmtx_t* lck; + int flags = 0; + + ASSERT(tb->common.status & DB_SET); hval = MAKE_HASH(key); - lck = WLOCK_HASH(tb,hval); - ix = hash_to_ix(tb, hval); - prevp = &BUCKET(tb, ix); - b = *prevp; + lck = WLOCK_HASH(tb, hval); + bp = &BUCKET(tb, hash_to_ix(tb, hval)); + b = *bp; - while (b != 0) { - if (has_live_key(tb,b,key,hval)) { - handle->tb = tbl; - handle->bp = (void**) prevp; - handle->dbterm = &b->dbterm; - handle->mustResize = 0; - handle->new_size = b->dbterm.size; - #if HALFWORD_HEAP - handle->abs_vec = NULL; - #endif - handle->lck = lck; - /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */ - return 1; - } - prevp = &b->next; - b = *prevp; + for (;;) { + if (b == NULL) { + break; + } + if (has_key(tb, b, key, hval)) { + if (b->hvalue != INVALID_HASH) { + goto Ldone; + } + break; + } + bp = &b->next; + b = *bp; } - WUNLOCK_HASH(lck); - return 0; + + if (obj == THE_NON_VALUE) { + WUNLOCK_HASH(lck); + return 0; + } + + { + Eterm *objp = tuple_val(obj); + int arity = arityval(*objp); + Eterm *htop, *hend; + + ASSERT(arity >= tb->common.keypos); + htop = HAlloc(p, arity + 1); + hend = htop + arity + 1; + sys_memcpy(htop, objp, sizeof(Eterm) * (arity + 1)); + htop[tb->common.keypos] = key; + obj = make_tuple(htop); + + if (b == NULL) { + HashDbTerm *q = new_dbterm(tb, obj); + + q->hvalue = hval; + q->next = NULL; + *bp = b = q; + + { + int nitems = erts_smp_atomic_inc_read_nob(&tb->common.nitems); + int nactive = NACTIVE(tb); + + if (nitems > nactive * (CHAIN_LEN + 1) && !IS_FIXED(tb)) { + grow(tb, nactive); + } + } + } else { + HashDbTerm *q, *next = b->next; + + ASSERT(b->hvalue == INVALID_HASH); + q = replace_dbterm(tb, b, obj); + q->next = next; + q->hvalue = hval; + *bp = b = q; + erts_smp_atomic_inc_nob(&tb->common.nitems); + } + + HRelease(p, hend, htop); + flags |= DB_NEW_OBJECT; + } + +Ldone: + handle->tb = tbl; + handle->bp = (void **)bp; + handle->dbterm = &b->dbterm; + handle->flags = flags; + handle->new_size = b->dbterm.size; +#if HALFWORD_HEAP + handle->abs_vec = NULL; +#endif + handle->lck = lck; + return 1; } /* Must be called after call to db_lookup_dbterm */ -static void db_finalize_dbterm_hash(DbUpdateHandle* handle) +static void +db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) { DbTable* tbl = handle->tb; - HashDbTerm* oldp = (HashDbTerm*) *(handle->bp); + DbTableHash *tb = &tbl->hash; + HashDbTerm **bp = (HashDbTerm **) handle->bp; + HashDbTerm *b = *bp; erts_smp_rwmtx_t* lck = (erts_smp_rwmtx_t*) handle->lck; - ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(&tbl->hash,lck)); /* locked by db_lookup_dbterm_hash */ + ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(tb, lck)); /* locked by db_lookup_dbterm_hash */ + + ASSERT((&b->dbterm == handle->dbterm) == !(tb->common.compress && handle->flags & DB_MUST_RESIZE)); - ASSERT((&oldp->dbterm == handle->dbterm) == !(tbl->common.compress && handle->mustResize)); + if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) { + if (IS_FIXED(tb)) { + add_fixed_deletion(tb, hash_to_ix(tb, b->hvalue)); + b->hvalue = INVALID_HASH; + } else { + *bp = b->next; + free_term(tb, b); + } - if (handle->mustResize) { + WUNLOCK_HASH(lck); + erts_smp_atomic_dec_nob(&tb->common.nitems); + try_shrink(tb); + } else if (handle->flags & DB_MUST_RESIZE) { db_finalize_resize(handle, offsetof(HashDbTerm,dbterm)); WUNLOCK_HASH(lck); - free_term(&tbl->hash, oldp); + free_term(tb, b); } else { WUNLOCK_HASH(lck); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 720c0659c3..c7bccc78c3 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -399,8 +399,11 @@ static int db_delete_all_objects_tree(Process* p, DbTable* tbl); #ifdef HARDDEBUG static void db_check_table_tree(DbTable *tbl); #endif -static int db_lookup_dbterm_tree(DbTable *, Eterm key, DbUpdateHandle*); -static void db_finalize_dbterm_tree(DbUpdateHandle*); +static int +db_lookup_dbterm_tree(Process *, DbTable *, Eterm key, Eterm obj, + DbUpdateHandle*); +static void +db_finalize_dbterm_tree(int cret, DbUpdateHandle *); /* ** Static variables @@ -1113,7 +1116,7 @@ static int db_select_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - CMP(mpi.least,mpi.most) == 0) { + CMP_EQ(mpi.least,mpi.most)) { doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */); RET_TO_BIF(sc.accum,DB_ERROR_NONE); } @@ -1321,7 +1324,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - CMP(mpi.least,mpi.most) == 0) { + CMP_EQ(mpi.least,mpi.most)) { doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */); RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); } @@ -1426,7 +1429,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - CMP(mpi.least,mpi.most) == 0) { + CMP_EQ(mpi.least,mpi.most)) { doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); if (sc.accum != NIL) { hp=HAlloc(p, 3); @@ -1670,7 +1673,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, sc.mp = mpi.mp; if (!mpi.got_partial && mpi.some_limitation && - CMP(mpi.least,mpi.most) == 0) { + CMP_EQ(mpi.least,mpi.most)) { doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); @@ -2546,16 +2549,43 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) return this; } -static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle) +static int +db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj, + DbUpdateHandle* handle) { DbTableTree *tb = &tbl->tree; TreeDbTerm **pp = find_node2(tb, key); - - if (pp == NULL) return 0; + int flags = 0; + + if (pp == NULL) { + if (obj == THE_NON_VALUE) { + return 0; + } else { + Eterm *objp = tuple_val(obj); + int arity = arityval(*objp); + Eterm *htop, *hend; + + ASSERT(arity >= tb->common.keypos); + htop = HAlloc(p, arity + 1); + hend = htop + arity + 1; + sys_memcpy(htop, objp, sizeof(Eterm) * (arity + 1)); + htop[tb->common.keypos] = key; + obj = make_tuple(htop); + + if (db_put_tree(tbl, obj, 1) != DB_ERROR_NONE) { + return 0; + } + + pp = find_node2(tb, key); + ASSERT(pp != NULL); + HRelease(p, hend, htop); + flags |= DB_NEW_OBJECT; + } + } handle->tb = tbl; handle->dbterm = &(*pp)->dbterm; - handle->mustResize = 0; + handle->flags = flags; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; #if HALFWORD_HEAP @@ -2564,15 +2594,21 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle return 1; } -static void db_finalize_dbterm_tree(DbUpdateHandle* handle) +static void +db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle) { - if (handle->mustResize) { - TreeDbTerm* oldp = (TreeDbTerm*) *handle->bp; + DbTable *tbl = handle->tb; + DbTableTree *tb = &tbl->tree; + TreeDbTerm *bp = (TreeDbTerm *) *handle->bp; + if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) { + Eterm ret; + db_erase_tree(tbl, GETKEY(tb, bp->dbterm.tpl), &ret); + } else if (handle->flags & DB_MUST_RESIZE) { db_finalize_resize(handle, offsetof(TreeDbTerm,dbterm)); - reset_static_stack(&handle->tb->tree); + reset_static_stack(tb); - free_term(&handle->tb->tree, oldp); + free_term(tb, bp); } #ifdef DEBUG handle->dbterm = 0; @@ -2680,7 +2716,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, *ret = this; return 1; } else if (partly_bound != NULL && key != am_Underscore && - db_is_variable(key) < 0) + db_is_variable(key) < 0 && !db_has_map(key)) *partly_bound = key; return 0; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 7eb80e3bb1..c6c3c55a7e 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -214,8 +214,8 @@ typedef enum { matchPushT, matchPushL, matchPushM, - matchPushK, matchPop, + matchSwap, matchBind, matchCmp, matchEqBin, @@ -225,12 +225,14 @@ typedef enum { matchEq, matchList, matchMap, + matchKey, matchSkip, matchPushC, matchConsA, /* Car is below Cdr */ matchConsB, /* Cdr is below Car (unusual) */ matchMkTuple, - matchMkMap, + matchMkFlatMap, + matchMkHashMap, matchCall0, matchCall1, matchCall2, @@ -1375,15 +1377,15 @@ restart: for (;;) { switch (t & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_BOXED: - if (is_map(t)) { - num_iters = map_get_size(map_val(t)); + if (is_flatmap(t)) { + num_iters = flatmap_get_size(flatmap_val(t)); if (!structure_checked) { DMC_PUSH(text, matchMap); DMC_PUSH(text, num_iters); } structure_checked = 0; for (i = 0; i < num_iters; ++i) { - Eterm key = map_get_keys(map_val(t))[i]; + Eterm key = flatmap_get_keys(flatmap_val(t))[i]; if (db_is_variable(key) >= 0) { if (context.err_info) { add_dmc_err(context.err_info, @@ -1399,24 +1401,85 @@ restart: } goto error; } - DMC_PUSH(text, matchPushK); - ++(context.stack_used); + DMC_PUSH(text, matchKey); DMC_PUSH(text, dmc_private_copy(&context, key)); + { + int old_stack = ++(context.stack_used); + Eterm value = flatmap_get_values(flatmap_val(t))[i]; + res = dmc_one_term(&context, &heap, &stack, &text, + value); + ASSERT(res != retFail); + if (res == retRestart) { + goto restart; + } + if (old_stack != context.stack_used) { + ASSERT(old_stack + 1 == context.stack_used); + DMC_PUSH(text, matchSwap); + } + if (context.stack_used > context.stack_need) { + context.stack_need = context.stack_used; + } + DMC_PUSH(text, matchPop); + --(context.stack_used); + } } - if (context.stack_used > context.stack_need) { - context.stack_need = context.stack_used; + break; + } + if (is_hashmap(t)) { + DECLARE_WSTACK(wstack); + Eterm *kv; + num_iters = hashmap_size(t); + if (!structure_checked) { + DMC_PUSH(text, matchMap); + DMC_PUSH(text, num_iters); } - for (i = num_iters; i--; ) { - Eterm value = map_get_values(map_val(t))[i]; - DMC_PUSH(text, matchPop); - --(context.stack_used); - res = dmc_one_term(&context, &heap, &stack, &text, - value); - ASSERT(res != retFail); - if (res == retRestart) { - goto restart; + structure_checked = 0; + + hashmap_iterator_init(&wstack, t, 0); + + while ((kv=hashmap_iterator_next(&wstack)) != NULL) { + Eterm key = CAR(kv); + Eterm value = CDR(kv); + if (db_is_variable(key) >= 0) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Variable found in map key.", + -1, 0UL, dmcError); + } + DESTROY_WSTACK(wstack); + goto error; + } else if (key == am_Underscore) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Underscore found in map key.", + -1, 0UL, dmcError); + } + DESTROY_WSTACK(wstack); + goto error; + } + DMC_PUSH(text, matchKey); + DMC_PUSH(text, dmc_private_copy(&context, key)); + { + int old_stack = ++(context.stack_used); + res = dmc_one_term(&context, &heap, &stack, &text, + value); + ASSERT(res != retFail); + if (res == retRestart) { + DESTROY_WSTACK(wstack); + goto restart; + } + if (old_stack != context.stack_used) { + ASSERT(old_stack + 1 == context.stack_used); + DMC_PUSH(text, matchSwap); + } + if (context.stack_used > context.stack_need) { + context.stack_need = context.stack_used; + } + DMC_PUSH(text, matchPop); + --(context.stack_used); } } + DESTROY_WSTACK(wstack); break; } if (!is_tuple(t)) { @@ -1945,32 +2008,52 @@ restart: FAIL(); } n = *pc++; - if (map_get_size(map_val_rel(*ep, base)) < n) { - FAIL(); - } - ep = map_val_rel(*ep, base); + if (is_flatmap_rel(*ep,base)) { + if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + FAIL(); + } + } else { + ASSERT(is_hashmap_rel(*ep,base)); + if (hashmap_size_rel(*ep, base) < n) { + FAIL(); + } + } + ep = flatmap_val_rel(*ep, base); break; case matchPushM: if (!is_map_rel(*ep, base)) { FAIL(); } n = *pc++; - if (map_get_size(map_val_rel(*ep, base)) < n) { - FAIL(); - } - *sp++ = map_val_rel(*ep++, base); + if (is_flatmap_rel(*ep,base)) { + if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + FAIL(); + } + } else { + ASSERT(is_hashmap_rel(*ep,base)); + if (hashmap_size_rel(*ep, base) < n) { + FAIL(); + } + } + *sp++ = flatmap_val_rel(*ep++, base); break; - case matchPushK: + case matchKey: t = (Eterm) *pc++; - tp = erts_maps_get_rel(t, make_map_rel(ep, base), base); + tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base); if (!tp) { FAIL(); } - *sp++ = tp; + *sp++ = ep; + ep = tp; break; case matchPop: ep = *(--sp); break; + case matchSwap: + tp = sp[-1]; + sp[-1] = sp[-2]; + sp[-2] = tp; + break; case matchBind: n = *pc++; variables[n].term = *ep++; @@ -2068,23 +2151,38 @@ restart: } *esp++ = t; break; - case matchMkMap: + case matchMkFlatMap: n = *pc++; - ehp = HAllocX(build_proc, 1 + MAP_HEADER_SIZE + n, HEAP_XTRA); - t = *ehp++ = *--esp; + ehp = HAllocX(build_proc, MAP_HEADER_FLATMAP_SZ + n, HEAP_XTRA); + t = *--esp; { - map_t *m = (map_t *)ehp; - m->thing_word = MAP_HEADER; + flatmap_t *m = (flatmap_t *)ehp; + m->thing_word = MAP_HEADER_FLATMAP; m->size = n; m->keys = t; } - t = make_map(ehp); - ehp += MAP_HEADER_SIZE; + t = make_flatmap(ehp); + ehp += MAP_HEADER_FLATMAP_SZ; while (n--) { *ehp++ = *--esp; } *esp++ = t; break; + case matchMkHashMap: + n = *pc++; + esp -= 2*n; + ehp = HAllocX(build_proc, 2*n, HEAP_XTRA); + { + ErtsHeapFactory factory; + Uint ix; + factory.p = build_proc; + for (ix = 0; ix < 2*n; ix++){ + ehp[ix] = esp[ix]; + } + t = erts_hashmap_from_array(&factory, ehp, n, 0); + } + *esp++ = t; + break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; t = (*bif)(build_proc, bif_args); @@ -2699,10 +2797,10 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) } ASSERT(((DbTableCommon*)handle->tb)->compress); - ASSERT(!handle->mustResize); + ASSERT(!(handle->flags & DB_MUST_RESIZE)); handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common, handle->dbterm); - handle->mustResize = 1; + handle->flags |= DB_MUST_RESIZE; return handle->dbterm->tpl[position]; } @@ -2735,11 +2833,11 @@ void db_do_update_element(DbUpdateHandle* handle, #endif return; } - if (!handle->mustResize) { + if (!(handle->flags & DB_MUST_RESIZE)) { if (handle->tb->common.compress) { handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common, handle->dbterm); - handle->mustResize = 1; + handle->flags |= DB_MUST_RESIZE; oldval = handle->dbterm->tpl[position]; #if HALFWORD_HEAP old_base = NULL; @@ -2799,7 +2897,7 @@ both_size_set: /* write new value in old dbterm, finalize will make a flat copy */ handle->dbterm->tpl[position] = newval; - handle->mustResize = 1; + handle->flags |= DB_MUST_RESIZE; #if HALFWORD_HEAP if (old_base && newval_sz > 0) { @@ -3249,6 +3347,37 @@ int db_is_variable(Eterm obj) return N; } +/* check if node is (or contains) a map + * return 1 if node contains a map + * return 0 otherwise + */ + +int db_has_map(Eterm node) { + DECLARE_ESTACK(s); + + ESTACK_PUSH(s,node); + while (!ESTACK_ISEMPTY(s)) { + node = ESTACK_POP(s); + if (is_list(node)) { + while (is_list(node)) { + ESTACK_PUSH(s,CAR(list_val(node))); + node = CDR(list_val(node)); + } + ESTACK_PUSH(s,node); /* Non wellformed list or [] */ + } else if (is_tuple(node)) { + Eterm *tuple = tuple_val(node); + int arity = arityval(*tuple); + while(arity--) { + ESTACK_PUSH(s,*(++tuple)); + } + } else if is_map(node) { + DESTROY_ESTACK(s); + return 1; + } + } + DESTROY_ESTACK(s); + return 0; +} /* check if obj is (or contains) a variable */ /* return 1 if obj contains a variable or underscore */ @@ -3275,7 +3404,19 @@ int db_has_variable(Eterm node) { while(arity--) { ESTACK_PUSH(s,*(++tuple)); } - } + } else if (is_flatmap(node)) { + Eterm *values = flatmap_get_values(flatmap_val(node)); + Uint size = flatmap_get_size(flatmap_val(node)); + ESTACK_PUSH(s, ((flatmap_t *) flatmap_val(node))->keys); + while (size--) { + ESTACK_PUSH(s, *(values++)); + } + } else if (is_map(node)) { /* other map-nodes or map-heads */ + Eterm *ptr = hashmap_val(node); + int i = hashmap_bitcount(MAP_HEADER_VAL(*ptr)); + ptr += MAP_HEADER_ARITY(*ptr); + while(i--) { ESTACK_PUSH(s, *++ptr); } + } break; case TAG_PRIMARY_IMMED1: if (node == am_Underscore || db_is_variable(node) >= 0) { @@ -3348,7 +3489,6 @@ static DMCRet dmc_one_term(DMCContext *context, Uint sz, sz2, sz3; Uint i, j; - switch (c & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_IMMED1: if ((n = db_is_variable(c)) >= 0) { /* variable */ @@ -3436,7 +3576,10 @@ static DMCRet dmc_one_term(DMCContext *context, DMC_PUSH(*stack, c); break; case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): - n = map_get_size(map_val(c)); + if (is_flatmap(c)) + n = flatmap_get_size(flatmap_val(c)); + else + n = hashmap_size(c); DMC_PUSH(*text, matchPushM); ++(context->stack_used); DMC_PUSH(*text, n); @@ -3727,30 +3870,87 @@ static DMCRet dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, Eterm t, int *constant) { - map_t *m = (map_t *)map_val(t); - Eterm *values = map_get_values(m); - int nelems = map_get_size(m); + int nelems; int constant_values; DMCRet ret; + if (is_flatmap(t)) { + flatmap_t *m = (flatmap_t *)flatmap_val(t); + Eterm *values = flatmap_get_values(m); - ret = dmc_array(context, heap, text, values, nelems, &constant_values); - if (ret != retOk) { - return ret; - } - if (constant_values) { - *constant = 1; + nelems = flatmap_get_size(m); + ret = dmc_array(context, heap, text, values, nelems, &constant_values); + + if (ret != retOk) { + return ret; + } + if (constant_values) { + *constant = 1; + return retOk; + } + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, dmc_private_copy(context, m->keys)); + if (++context->stack_used > context->stack_need) { + context->stack_need = context->stack_used; + } + DMC_PUSH(*text, matchMkFlatMap); + DMC_PUSH(*text, nelems); + context->stack_used -= nelems; + *constant = 0; + return retOk; + } else { + DECLARE_WSTACK(wstack); + Eterm *kv; + int c; + + ASSERT(is_hashmap(t)); + + hashmap_iterator_init(&wstack, t, 1); + constant_values = 1; + nelems = hashmap_size(t); + + while ((kv=hashmap_iterator_prev(&wstack)) != NULL) { + if ((ret = dmc_expr(context, heap, text, CDR(kv), &c)) != retOk) { + DESTROY_WSTACK(wstack); + return ret; + } + if (!c) + constant_values = 0; + } + + if (constant_values) { + *constant = 1; + DESTROY_WSTACK(wstack); + return retOk; + } + + *constant = 0; + + hashmap_iterator_init(&wstack, t, 1); + + while ((kv=hashmap_iterator_prev(&wstack)) != NULL) { + /* push key */ + if ((ret = dmc_expr(context, heap, text, CAR(kv), &c)) != retOk) { + DESTROY_WSTACK(wstack); + return ret; + } + if (c) { + do_emit_constant(context, text, CAR(kv)); + } + /* push value */ + if ((ret = dmc_expr(context, heap, text, CDR(kv), &c)) != retOk) { + DESTROY_WSTACK(wstack); + return ret; + } + if (c) { + do_emit_constant(context, text, CDR(kv)); + } + } + DMC_PUSH(*text, matchMkHashMap); + DMC_PUSH(*text, nelems); + context->stack_used -= nelems; + DESTROY_WSTACK(wstack); return retOk; } - DMC_PUSH(*text, matchPushC); - DMC_PUSH(*text, dmc_private_copy(context, m->keys)); - if (++context->stack_used > context->stack_need) { - context->stack_need = context->stack_used; - } - DMC_PUSH(*text, matchMkMap); - DMC_PUSH(*text, nelems); - context->stack_used -= nelems; - *constant = 0; - return retOk; } static DMCRet dmc_whole_expression(DMCContext *context, @@ -5302,6 +5502,12 @@ void db_match_dis(Binary *bp) ++t; erts_printf("Map\t%beu\n", n); break; + case matchKey: + ++t; + p = (Eterm) *t; + ++t; + erts_printf("Key\t%p (%T)\n", t, p); + break; case matchPushT: ++t; n = *t; @@ -5318,16 +5524,14 @@ void db_match_dis(Binary *bp) ++t; erts_printf("PushM\t%beu\n", n); break; - case matchPushK: - ++t; - p = (Eterm) *t; - ++t; - erts_printf("PushK\t%p (%T)\n", t, p); - break; case matchPop: ++t; erts_printf("Pop\n"); break; + case matchSwap: + ++t; + erts_printf("Swap\n"); + break; case matchBind: ++t; n = *t; @@ -5440,11 +5644,17 @@ void db_match_dis(Binary *bp) ++t; erts_printf("MkTuple\t%beu\n", n); break; - case matchMkMap: + case matchMkFlatMap: + ++t; + n = *t; + ++t; + erts_printf("MkFlatMap\t%beu\n", n); + break; + case matchMkHashMap: ++t; n = *t; ++t; - erts_printf("MkMapA\t%beu\n", n); + erts_printf("MkHashMap\t%beu\n", n); break; case matchOr: ++t; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 5ace93c8ed..b2d5a306cb 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -76,6 +76,9 @@ typedef struct db_term { union db_table; typedef union db_table DbTable; +#define DB_MUST_RESIZE 1 +#define DB_NEW_OBJECT 2 + /* Info about a database entry while it's being updated * (by update_counter or update_element) */ @@ -84,7 +87,7 @@ typedef struct { DbTerm* dbterm; void** bp; /* {Hash|Tree}DbTerm** */ Uint new_size; - int mustResize; + int flags; void* lck; #if HALFWORD_HEAP unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */ @@ -183,15 +186,14 @@ typedef struct db_table_method void *arg); void (*db_check_table)(DbTable* tb); - /* Lookup a dbterm for updating. Return false if not found. - */ - int (*db_lookup_dbterm)(DbTable*, Eterm key, - DbUpdateHandle* handle); /* [out] */ + /* Lookup a dbterm for updating. Return false if not found. */ + int (*db_lookup_dbterm)(Process *, DbTable *, Eterm key, Eterm obj, + DbUpdateHandle* handle); - /* Must be called for each db_lookup_dbterm that returned true, - ** even if dbterm was not updated. - */ - void (*db_finalize_dbterm)(DbUpdateHandle* handle); + /* Must be called for each db_lookup_dbterm that returned true, even if + ** dbterm was not updated. If the handle was of a new object and cret is + ** not DB_ERROR_NONE, the object is removed from the table. */ + void (*db_finalize_dbterm)(int cret, DbUpdateHandle* handle); } DbTableMethod; @@ -340,6 +342,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj, Uint pos, Eterm** hpp, Uint extra); +int db_has_map(Eterm obj); int db_has_variable(Eterm obj); int db_is_variable(Eterm obj); void db_do_update_element(DbUpdateHandle* handle, diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 31b05d22af..240faa823d 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -604,10 +604,12 @@ erl_drv_thread_create(char *name, ethr_thr_opts ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; ethr_thr_opts *use_opts; - if (!opts) + if (!opts && !name) use_opts = NULL; else { - ethr_opts.suggested_stack_size = opts->suggested_stack_size; + if(opts) + ethr_opts.suggested_stack_size = opts->suggested_stack_size; + ethr_opts.name = name; use_opts = ðr_opts; } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index d1a7ee113b..1785fc27be 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -39,6 +39,7 @@ #include "hipe_mode_switch.h" #endif #include "dtrace-wrapper.h" +#include "erl_bif_unique.h" #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 @@ -402,7 +403,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { Uint reclaimed_now = 0; int done = 0; - Uint ms1, s1, us1; + ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); @@ -419,10 +420,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) trace_gc(p, am_gc_start); } - erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); - 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); @@ -470,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) { @@ -1224,7 +1222,6 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) Uint n; Uint new_sz; Uint fragments = MBUF_SIZE(p) + combined_message_size(p); - ErlMessage *msgp; size_before = fragments + (HEAP_TOP(p) - HEAP_START(p)); @@ -1434,13 +1431,16 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) ErtsGcQuickSanityCheck(p); - /* - * Copy newly received message onto the end of the new heap. - */ - 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); + { + ErlMessage *msgp; + /* + * Copy newly received message onto the end of the new heap. + */ + 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); + } } } @@ -1503,13 +1503,12 @@ adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int static Uint combined_message_size(Process* p) { - Uint sz = 0; + Uint sz; ErlMessage *msgp; - for (msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) { + for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached) sz += erts_msg_attached_data_size(msgp); - } } return sz; } @@ -2647,11 +2646,7 @@ reply_gc_info(void *vgcirp) hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, msg, NIL); if (gcirp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2659,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); @@ -2683,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_gc.h b/erts/emulator/beam/erl_gc.h index bf0496c112..bd6dcc9078 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -55,7 +55,10 @@ do { \ nelts = header_arity(HDR); \ switch ((HDR) & _HEADER_SUBTAG_MASK) { \ case SUB_BINARY_SUBTAG: nelts++; break; \ - case MAP_SUBTAG: nelts+=map_get_size(PTR) + 1; break; \ + case MAP_SUBTAG: \ + if (is_flatmap_header(HDR)) nelts+=flatmap_get_size(PTR) + 1; \ + else nelts += hashmap_bitcount(MAP_HEADER_VAL(HDR)); \ + break; \ case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR))->num_free+1; break; \ } \ gval = make_boxed(HTOP); \ @@ -63,7 +66,6 @@ do { \ *HTOP++ = HDR; \ *PTR++ = gval; \ while (nelts--) *HTOP++ = *PTR++; \ - \ } while(0) #define in_area(ptr,start,nbytes) \ 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 77445ef1ff..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" @@ -45,6 +45,9 @@ #include "erl_thr_queue.h" #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() */ @@ -117,6 +120,8 @@ const int etp_big_endian = 1; #else const int etp_big_endian = 0; #endif +const Eterm etp_the_non_value = THE_NON_VALUE; + /* * Note about VxWorks: All variables must be initialized by executable code, * not by an initializer. Otherwise a new instance of the emulator will @@ -134,7 +139,9 @@ static void erl_init(int ncpu, int legacy_proc_tab, int port_tab_sz, int port_tab_sz_ignore_files, - int legacy_port_tab); + int legacy_port_tab, + int time_correction, + ErtsTimeWarpMode time_warp_mode); static erts_atomic_t exiting; @@ -185,12 +192,10 @@ static int no_dirty_io_schedulers; Uint32 verbose; /* See erl_debug.h for information about verbose */ #endif -int erts_disable_tolerant_timeofday; /* Time correction can be disabled it is - * not and/or it is too slow. - */ - int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */ +int erts_pd_initial_size = 10; + int erts_modified_timing_level; int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */ @@ -266,6 +271,19 @@ this_rel_num(void) return this_rel; } +static ERTS_INLINE void +set_default_time_adj(int *time_correction_p, ErtsTimeWarpMode *time_warp_mode_p) +{ + *time_correction_p = 1; + *time_warp_mode_p = ERTS_NO_TIME_WARP_MODE; + if (!erts_check_time_adj_support(*time_correction_p, + *time_warp_mode_p)) { + *time_correction_p = 0; + ASSERT(erts_check_time_adj_support(*time_correction_p, + *time_warp_mode_p)); + } +} + /* * Common error printout function, all error messages * that don't go to the error logger go through here. @@ -281,13 +299,22 @@ static int early_init(int *argc, char **argv); void erts_short_init(void) { - int ncpu = early_init(NULL, NULL); + + int ncpu; + int time_correction; + ErtsTimeWarpMode time_warp_mode; + + set_default_time_adj(&time_correction, + &time_warp_mode); + ncpu = early_init(NULL, NULL); erl_init(ncpu, ERTS_DEFAULT_MAX_PROCESSES, 0, ERTS_DEFAULT_MAX_PORTS, 0, - 0); + 0, + time_correction, + time_warp_mode); erts_initialized = 1; } @@ -297,12 +324,15 @@ erl_init(int ncpu, int legacy_proc_tab, int port_tab_sz, int port_tab_sz_ignore_files, - int legacy_port_tab) + int legacy_port_tab, + int time_correction, + ErtsTimeWarpMode time_warp_mode) { init_benchmarking(); + erts_bif_unique_init(); erts_init_monitors(); - erts_init_time(); + erts_init_time(time_correction, time_warp_mode); erts_init_sys_common_misc(); erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab); erts_init_scheduling(no_schedulers, @@ -313,6 +343,7 @@ erl_init(int ncpu, no_dirty_io_schedulers #endif ); + erts_late_init_time_sup(); erts_init_cpu_topology(); /* Must be after init_scheduling */ erts_init_gc(); /* Must be after init_scheduling */ erts_alloc_late_init(); @@ -336,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(); @@ -362,12 +392,13 @@ erl_init(int ncpu, erl_nif_init(); } -static void +static Eterm erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** argv) { int i; Eterm start_mod; Eterm args; + Eterm res; Eterm* hp; Process parent; ErlSpawnOpts so; @@ -397,10 +428,11 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** hp += 2; args = CONS(hp, env, args); - so.flags = 0; - (void) erl_create_process(&parent, start_mod, am_start, args, &so); + so.flags = SPO_SYSTEM_PROC; + res = erl_create_process(&parent, start_mod, am_start, args, &so); erts_smp_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN); erts_cleanup_empty_process(&parent); + return res; } Eterm @@ -506,9 +538,9 @@ void erts_usage(void) /* erts_fprintf(stderr, "-b func set the boot function (default boot)\n"); */ - erts_fprintf(stderr, "-c disable continuous date/time correction with\n"); - erts_fprintf(stderr, " respect to uptime\n"); - + erts_fprintf(stderr, "-c bool enable or disable time correction\n"); + erts_fprintf(stderr, "-C mode set time warp mode; valid modes are:\n"); + erts_fprintf(stderr, " no_time_warp|single_time_warp|multi_time_warp\n"); erts_fprintf(stderr, "-d don't write a crash dump for internally detected errors\n"); erts_fprintf(stderr, " (halt(String) will still produce a crash dump)\n"); erts_fprintf(stderr, "-fn[u|a|l] Control how filenames are interpreted\n"); @@ -516,6 +548,8 @@ void erts_usage(void) H_DEFAULT_SIZE); erts_fprintf(stderr, "-hmbs size set minimum binary virtual heap size in words (default %d)\n", VH_DEFAULT_SIZE); + erts_fprintf(stderr, "-hpds size initial process dictionary size (default %d)\n", + erts_pd_initial_size); /* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */ @@ -678,7 +712,6 @@ early_init(int *argc, char **argv) /* erts_sched_compact_load = 1; erts_printf_eterm_func = erts_printf_term; - erts_disable_tolerant_timeofday = 0; display_items = 200; erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE; erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS; @@ -1184,7 +1217,11 @@ erl_start(int argc, char **argv) int port_tab_sz_ignore_files = 0; int legacy_proc_tab = 0; int legacy_port_tab = 0; + int time_correction; + ErtsTimeWarpMode time_warp_mode; + set_default_time_adj(&time_correction, + &time_warp_mode); envbufsz = sizeof(envbuf); if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0) @@ -1405,6 +1442,7 @@ erl_start(int argc, char **argv) * * h|ms - min_heap_size * h|mbs - min_bin_vheap_size + * h|pds - erts_pd_initial_size * */ if (has_prefix("mbs", sub_param)) { @@ -1422,6 +1460,14 @@ erl_start(int argc, char **argv) erts_usage(); } VERBOSE(DEBUG_SYSTEM, ("using minimum heap size %d\n", H_MIN_SIZE)); + } else if (has_prefix("pds", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + if ((erts_pd_initial_size = atoi(arg)) <= 0) { + erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, ("using initial process dictionary size %d\n", + erts_pd_initial_size)); } else { /* backward compatibility */ arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -1893,9 +1939,50 @@ erl_start(int argc, char **argv) } break; } + case 'C': + arg = get_arg(argv[i]+2, argv[i+1], &i); + if (sys_strcmp(arg, "no_time_warp") == 0) + time_warp_mode = ERTS_NO_TIME_WARP_MODE; + else if (sys_strcmp(arg, "single_time_warp") == 0) + time_warp_mode = ERTS_SINGLE_TIME_WARP_MODE; + else if (sys_strcmp(arg, "multi_time_warp") == 0) + time_warp_mode = ERTS_MULTI_TIME_WARP_MODE; + else { + erts_fprintf(stderr, + "Invalid time warp mode: %s\n", arg); + erts_usage(); + } + break; case 'c': - if (argv[i][2] == 0) { /* -c: documented option */ - erts_disable_tolerant_timeofday = 1; + if (sys_strcmp(argv[i]+2, "false") == 0) + goto time_correction_false; + else if (sys_strcmp(argv[i]+2, "true") == 0) + goto time_correction_true; + else if (argv[i][2] == '\0') { + if (i + 1 >= argc) + goto time_correction_false; + else { + if (sys_strcmp(argv[i+1], "false") == 0) { + (void) get_arg(argv[i]+2, argv[i+1], &i); + goto time_correction_false; + } + else if (sys_strcmp(argv[i+1], "true") == 0) { + (void) get_arg(argv[i]+2, argv[i+1], &i); + time_correction_true: + time_correction = 1; + break; + } + else { + time_correction_false: + time_correction = 0; + break; + } + } + } + else { + arg = get_arg(argv[i]+2, argv[i+1], &i); + erts_fprintf(stderr, "Invalid time correnction value: %s\n", arg); + erts_usage(); } break; case 'W': @@ -1942,6 +2029,30 @@ erl_start(int argc, char **argv) i++; } + if (!erts_check_time_adj_support(time_correction, time_warp_mode)) { + char *time_correction_str = time_correction ? "Enabled" : "Disabled"; + char *time_warp_str = "undefined"; + switch (time_warp_mode) { + case ERTS_NO_TIME_WARP_MODE: + time_warp_str = "no"; + break; + case ERTS_SINGLE_TIME_WARP_MODE: + time_warp_str = "single"; + break; + case ERTS_MULTI_TIME_WARP_MODE: + time_warp_str = "multi"; + break; + default: + time_warp_str = "undefined"; + break; + } + erts_fprintf(stderr, "%s time correction with %s time warp mode " + "is not supported on this platform\n", + time_correction_str, + time_warp_str); + erts_usage(); + } + /* Output format on windows for sprintf defaults to three exponents. * We use two-exponent to mimic normal sprintf behaviour. */ @@ -1975,7 +2086,9 @@ erl_start(int argc, char **argv) legacy_proc_tab, port_tab_sz, port_tab_sz_ignore_files, - legacy_port_tab); + legacy_port_tab, + time_correction, + time_warp_mode); load_preloaded(); erts_end_staging_code_ix(); @@ -1983,7 +2096,8 @@ erl_start(int argc, char **argv) erts_initialized = 1; - erl_first_process_otp("otp_ring0", NULL, 0, boot_argc, boot_argv); + (void) erl_first_process_otp("otp_ring0", NULL, 0, + boot_argc, boot_argv); #ifdef ERTS_SMP erts_start_schedulers(); @@ -1991,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 b105ece6f1..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 }, @@ -140,7 +141,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "async_enq_mtx", NULL }, #ifdef ERTS_SMP { "atom_tab", NULL }, - { "make_ref", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, { "message_pre_alloc_lock", "address" }, { "ptimer_pre_alloc_lock", "address", }, @@ -168,6 +168,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "timer_wheel", NULL }, { "system_block", NULL }, { "timeofday", NULL }, + { "get_time", NULL }, + { "get_corrected_time", NULL }, { "breakpoints", NULL }, { "pollsets_lock", NULL }, { "pix_lock", "address" }, @@ -184,10 +186,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "efile_drv dtrace mutex", NULL }, #endif { "mtrace_buf", NULL }, -#ifdef __WIN32__ #ifdef ERTS_SMP - { "sys_gethrtime", NULL }, -#endif + { "os_monotonic_time", NULL }, #endif { "erts_alloc_hard_debug", NULL }, { "hard_dbg_mseg", NULL }, diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index cf6996ea06..c6d8f4df95 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -104,17 +104,13 @@ static void lcnt_clear_stats(erts_lcnt_lock_stats_t *stats) { } static void lcnt_time(erts_lcnt_time_t *time) { -#if 0 || defined(HAVE_GETHRTIME) - SysHrTime hr_time; - hr_time = sys_gethrtime(); - time->s = (unsigned long)(hr_time / 1000000000LL); - time->ns = (unsigned long)(hr_time - 1000000000LL*time->s); -#else - SysTimeval tv; - sys_gettimeofday(&tv); - time->s = tv.tv_sec; - time->ns = tv.tv_usec*1000LL; -#endif + /* + * erts_sys_hrtime() is the highest resolution + * we could find, it may or may not be monotonic... + */ + ErtsMonotonicTime mtime = erts_sys_hrtime(); + time->s = (unsigned long) (mtime / 1000000000LL); + time->ns = (unsigned long) (mtime - 1000000000LL*time->s); } static void lcnt_time_diff(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) { diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index ffbb93da1b..09fadd7e9e 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -76,7 +76,7 @@ /* histogram */ #define ERTS_LCNT_HISTOGRAM_MAX_NS (((unsigned long)1LL << 28) - 1) -#if 0 || defined(HAVE_GETHRTIME) +#if 0 || defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) #define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (30) #define ERTS_LCNT_HISTOGRAM_RSHIFT (0) #else diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index b2a16eb5ed..a1bd39dbc8 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -16,6 +16,9 @@ * * %CopyrightEnd% * + * hashmaps are an adaption of Rich Hickeys Persistent HashMaps + * which were an adaption of Phil Bagwells - Hash Array Mapped Tries + * * Author: Björn-Egil Dahlberg */ @@ -62,39 +65,73 @@ * - erts_internal:map_to_tuple_keys/1 */ +#ifndef DECL_AM +#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) +#endif + +/* for hashmap_from_list/1 */ +typedef struct { + Uint32 hx; + Uint32 skip; + Uint i; + Eterm val; +} hxnode_t; + + +static Eterm flatmap_merge(Process *p, Eterm nodeA, Eterm nodeB); +static Eterm map_merge_mixed(Process *p, Eterm flat, Eterm tree, int swap_args); +static Eterm hashmap_merge(Process *p, Eterm nodeA, Eterm nodeB); +static Eterm hashmap_to_list(Process *p, Eterm map); +static Eterm hashmap_keys(Process *p, Eterm map); +static Eterm hashmap_values(Process *p, Eterm map); +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node); +static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size); +static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size); +static Eterm hashmap_from_unsorted_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int reject_dupkeys); +static Eterm hashmap_from_sorted_unique_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int is_root); +static Eterm hashmap_from_chunked_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, Uint size, int is_root); +static Eterm hashmap_info(Process *p, Eterm node); +static Eterm hashmap_bld_tuple_uint(Uint **hpp, Uint *szp, Uint n, Uint nums[]); +static int hxnodecmp(hxnode_t* a, hxnode_t* b); +static int hxnodecmpkey(hxnode_t* a, hxnode_t* b); + /* erlang:map_size/1 * the corresponding instruction is implemented in: * beam/erl_bif_guard.c */ BIF_RETTYPE map_size_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { - Eterm *hp; - Uint hsz = 0; - map_t *mp = (map_t*)map_val(BIF_ARG_1); - Uint n = map_get_size(mp); - - erts_bld_uint(NULL, &hsz, n); + if (is_flatmap(BIF_ARG_1)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1); + BIF_RET(make_small(flatmap_get_size(mp))); + } else if (is_hashmap(BIF_ARG_1)) { + Eterm *head, *hp, res; + Uint size, hsz=0; + + head = hashmap_val(BIF_ARG_1); + size = head[1]; + (void) erts_bld_uint(NULL, &hsz, size); hp = HAlloc(BIF_P, hsz); - BIF_RET(erts_bld_uint(&hp, NULL, n)); + res = erts_bld_uint(&hp, NULL, size); + BIF_RET(res); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); } -/* maps:to_list/1 - */ +/* maps:to_list/1 */ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { + if (is_flatmap(BIF_ARG_1)) { Uint n; Eterm* hp; Eterm *ks,*vs, res, tup; - map_t *mp = (map_t*)map_val(BIF_ARG_1); + flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1); - ks = map_get_keys(mp); - vs = map_get_values(mp); - n = map_get_size(mp); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + n = flatmap_get_size(mp); hp = HAlloc(BIF_P, (2 + 3) * n); res = NIL; @@ -104,9 +141,12 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { } BIF_RET(res); + } else if (is_hashmap(BIF_ARG_1)) { + return hashmap_to_list(BIF_P, BIF_ARG_1); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); } /* maps:find/2 @@ -120,34 +160,41 @@ erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base) erts_maps_get(Eterm key, Eterm map) #endif { - Eterm *ks, *vs; - map_t *mp; - Uint n, i; + Uint32 hx; + if (is_flatmap_rel(map, map_base)) { + Eterm *ks, *vs; + flatmap_t *mp; + Uint n, i; - mp = (map_t *)map_val_rel(map, map_base); - n = map_get_size(mp); + mp = (flatmap_t *)flatmap_val_rel(map, map_base); + n = flatmap_get_size(mp); - if (n == 0) { - return NULL; - } + if (n == 0) { + return NULL; + } - ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; - vs = map_get_values(mp); + ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; + vs = flatmap_get_values(mp); - if (is_immed(key)) { - for (i = 0; i < n; i++) { - if (ks[i] == key) { - return &vs[i]; - } - } - } + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (ks[i] == key) { + return &vs[i]; + } + } + } - for (i = 0; i < n; i++) { - if (eq_rel(ks[i], NULL, key, map_base)) { - return &vs[i]; - } + for (i = 0; i < n; i++) { + if (eq_rel(ks[i], map_base, key, NULL)) { + return &vs[i]; + } + } + return NULL; } - return NULL; + ASSERT(is_hashmap_rel(map, map_base)); + hx = hashmap_make_hash(key); + + return erts_hashmap_get_rel(hx, key, map, map_base); } BIF_RETTYPE maps_find_2(BIF_ALIST_2) { @@ -164,37 +211,31 @@ BIF_RETTYPE maps_find_2(BIF_ALIST_2) { *hp++ = *value; BIF_RET(res); } - BIF_RET(am_error); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); } /* maps:get/2 * return value if key *matches* a key in the map - * exception bad_key if none matches + * exception badkey if none matches */ BIF_RETTYPE maps_get_2(BIF_ALIST_2) { if (is_map(BIF_ARG_2)) { - Eterm *hp; - Eterm error; const Eterm *value; - char *s_error; value = erts_maps_get(BIF_ARG_1, BIF_ARG_2); if (value) { BIF_RET(*value); } - s_error = "bad_key"; - error = am_atom_put(s_error, sys_strlen(s_error)); - - hp = HAlloc(BIF_P, 3); - BIF_P->fvalue = TUPLE2(hp, error, BIF_ARG_1); - BIF_ERROR(BIF_P, EXC_ERROR_2); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADKEY); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); } /* maps:from_list/1 @@ -202,13 +243,8 @@ BIF_RETTYPE maps_get_2(BIF_ALIST_2) { */ BIF_RETTYPE maps_from_list_1(BIF_ALIST_1) { - Eterm *kv, item = BIF_ARG_1; - Eterm *hp, *thp,*vs, *ks, keys, res; - map_t *mp; - Uint size = 0, unused_size = 0; - Sint c = 0; - Sint idx = 0; - + Eterm item = BIF_ARG_1, res, *kv; + Uint size = 0; if (is_list(item) || is_nil(item)) { /* Calculate size and check validity */ @@ -229,450 +265,1221 @@ BIF_RETTYPE maps_from_list_1(BIF_ALIST_1) { if (is_not_nil(item)) goto error; - hp = HAlloc(BIF_P, 3 + 1 + (2 * size)); - thp = hp; + if (size > MAP_SMALL_MAP_LIMIT) { + BIF_RET(hashmap_from_validated_list(BIF_P, BIF_ARG_1, size)); + } else { + BIF_RET(flatmap_from_validated_list(BIF_P, BIF_ARG_1, size)); + } + } + +error: + + BIF_ERROR(BIF_P, BADARG); +} + +static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size) { + Eterm *kv, item = list; + Eterm *hp, *thp,*vs, *ks, keys, res; + flatmap_t *mp; + Uint unused_size = 0; + Sint c = 0; + Sint idx = 0; + + + hp = HAlloc(p, 3 + 1 + (2 * size)); + thp = hp; + keys = make_tuple(hp); + *hp++ = make_arityval(size); + ks = hp; + hp += size; + mp = (flatmap_t*)hp; + res = make_flatmap(mp); + hp += MAP_HEADER_FLATMAP_SZ; + vs = hp; + + mp->thing_word = MAP_HEADER_FLATMAP; + mp->size = size; /* set later, might shrink*/ + mp->keys = keys; + + if (size == 0) + return res; + + /* first entry */ + kv = tuple_val(CAR(list_val(item))); + ks[0] = kv[1]; + vs[0] = kv[2]; + size = 1; + item = CDR(list_val(item)); + + /* insert sort key/value pairs */ + while(is_list(item)) { + + kv = tuple_val(CAR(list_val(item))); + + /* compare ks backwards + * idx represent word index to be written (hole position). + * We cannot copy the elements when searching since we might + * have an equal key. So we search for just the index first =( + * + * It is perhaps faster to move the values in the first pass. + * Check for uniqueness during insert phase and then have a + * second phace compacting the map if duplicates are found + * during insert. .. or do someother sort .. shell-sort perhaps. + */ + + idx = size; + + while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; } + + if (c == 0) { + /* last compare was equal, + * i.e. we have to release memory + * and overwrite that key/value + */ + ks[idx-1] = kv[1]; + vs[idx-1] = kv[2]; + unused_size++; + } else { + Uint i = size; + while(i > idx) { + ks[i] = ks[i-1]; + vs[i] = vs[i-1]; + i--; + } + ks[idx] = kv[1]; + vs[idx] = kv[2]; + size++; + } + item = CDR(list_val(item)); + } + + if (unused_size) { + /* the key tuple is embedded in the heap + * write a bignum to clear it. + */ + /* release values as normal since they are on the top of the heap */ + + ks[size] = make_pos_bignum_header(unused_size - 1); + HRelease(p, vs + size + unused_size, vs + size); + } + + *thp = make_arityval(size); + mp->size = size; + return res; +} + +#define swizzle32(D,S) \ + do { \ + (D) = ((S) & 0x0000000f) << 28 | ((S) & 0x000000f0) << 20 \ + | ((S) & 0x00000f00) << 12 | ((S) & 0x0000f000) << 4 \ + | ((S) & 0x000f0000) >> 4 | ((S) & 0x00f00000) >> 12 \ + | ((S) & 0x0f000000) >> 20 | ((S) & 0xf0000000) >> 28; \ + } while(0) + +#define maskval(V,L) (((V) >> ((7 - (L))*4)) & 0xf) +#define cdepth(V1,V2) (hashmap_clz((V1) ^ (V2)) >> 2) + +static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size) { + Eterm item = list; + Eterm *hp; + Eterm *kv, res; + Uint32 sw, hx; + Uint ix = 0; + hxnode_t *hxns; + ErtsHeapFactory factory; + DeclareTmpHeap(tmp,2,p); + ASSERT(size > 0); + + hp = HAlloc(p, (2 * size)); + + /* create tmp hx values and leaf ptrs */ + hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, size * sizeof(hxnode_t)); + + UseTmpHeap(2,p); + while(is_list(item)) { + res = CAR(list_val(item)); + kv = tuple_val(res); + hx = hashmap_restore_hash(tmp,0,kv[1]); + swizzle32(sw,hx); + hxns[ix].hx = sw; + hxns[ix].val = CONS(hp, kv[1], kv[2]); hp += 2; + hxns[ix].skip = 1; /* will be reassigned in from_array */ + hxns[ix].i = ix; + ix++; + item = CDR(list_val(item)); + } + UnUseTmpHeap(2,p); + + factory.p = p; + res = hashmap_from_unsorted_array(&factory, hxns, size, 0); + + erts_free(ERTS_ALC_T_TMP, (void *) hxns); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); + + if (hashmap_size(res) <= MAP_SMALL_MAP_LIMIT) { + DECLARE_WSTACK(wstack); + Eterm *kv, *ks, *vs; + flatmap_t *mp; + Eterm keys; + Uint n = hashmap_size(res); + + /* build flat structure */ + hp = HAlloc(p, 3 + 1 + (2 * n)); keys = make_tuple(hp); - *hp++ = make_arityval(size); + *hp++ = make_arityval(n); ks = hp; - hp += size; - mp = (map_t*)hp; - res = make_map(mp); - hp += MAP_HEADER_SIZE; + hp += n; + mp = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; vs = hp; - mp->thing_word = MAP_HEADER; - mp->size = size; /* set later, might shrink*/ + mp->thing_word = MAP_HEADER_FLATMAP; + mp->size = n; mp->keys = keys; - if (size == 0) - BIF_RET(res); + hashmap_iterator_init(&wstack, res, 0); - item = BIF_ARG_1; + while ((kv=hashmap_iterator_next(&wstack)) != NULL) { + *ks++ = CAR(kv); + *vs++ = CDR(kv); + } - /* first entry */ - kv = tuple_val(CAR(list_val(item))); - ks[0] = kv[1]; - vs[0] = kv[2]; - size = 1; - item = CDR(list_val(item)); + /* it cannot have multiple keys */ + erts_validate_and_sort_flatmap(mp); - /* insert sort key/value pairs */ - while(is_list(item)) { + DESTROY_WSTACK(wstack); + return make_flatmap(mp); + } - kv = tuple_val(CAR(list_val(item))); - - /* compare ks backwards - * idx represent word index to be written (hole position). - * We cannot copy the elements when searching since we might - * have an equal key. So we search for just the index first =( - * - * It is perhaps faster to move the values in the first pass. - * Check for uniqueness during insert phase and then have a - * second phace compacting the map if duplicates are found - * during insert. .. or do someother sort .. shell-sort perhaps. - */ + return res; +} - idx = size; +Eterm erts_hashmap_from_array(ErtsHeapFactory* factory, Eterm *leafs, Uint n, + int reject_dupkeys) { + Uint32 sw, hx; + Uint ix; + hxnode_t *hxns; + Eterm res; + + /* create tmp hx values and leaf ptrs */ + hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(hxnode_t)); + + for (ix = 0; ix < n; ix++) { + hx = hashmap_make_hash(*leafs); + swizzle32(sw,hx); + hxns[ix].hx = sw; + hxns[ix].val = make_list(leafs); + hxns[ix].skip = 1; + hxns[ix].i = ix; + leafs += 2; + } - while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; } + res = hashmap_from_unsorted_array(factory, hxns, n, reject_dupkeys); - if (c == 0) { - /* last compare was equal, - * i.e. we have to release memory - * and overwrite that key/value - */ - ks[idx-1] = kv[1]; - vs[idx-1] = kv[2]; - unused_size++; - } else { - Uint i = size; - while(i > idx) { - ks[i] = ks[i-1]; - vs[i] = vs[i-1]; - i--; + erts_free(ERTS_ALC_T_TMP, (void *) hxns); + + return res; +} + + +Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint n, + Eterm key, Eterm value) { + Uint32 sw, hx; + Uint i,sz; + hxnode_t *hxns; + ErtsHeapFactory factory; + Eterm *hp, res; + + sz = (key == THE_NON_VALUE) ? n : (n + 1); + ASSERT(sz > MAP_SMALL_MAP_LIMIT); + hp = HAlloc(p, 2 * sz); + + /* create tmp hx values and leaf ptrs */ + hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, sz * sizeof(hxnode_t)); + + for(i = 0; i < n; i++) { + hx = hashmap_make_hash(ks[i]); + swizzle32(sw,hx); + hxns[i].hx = sw; + hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2; + hxns[i].skip = 1; /* will be reassigned in from_array */ + hxns[i].i = i; + } + + if (key != THE_NON_VALUE) { + hx = hashmap_make_hash(key); + swizzle32(sw,hx); + hxns[i].hx = sw; + hxns[i].val = CONS(hp, key, value); hp += 2; + hxns[i].skip = 1; + hxns[i].i = i; + } + + factory.p = p; + res = hashmap_from_unsorted_array(&factory, hxns, sz, 0); + + erts_free(ERTS_ALC_T_TMP, (void *) hxns); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); + + return res; +} + +static Eterm hashmap_from_unsorted_array(ErtsHeapFactory* factory, + hxnode_t *hxns, Uint n, + int reject_dupkeys) { + Uint jx = 0, ix = 0, lx, cx; + Eterm res; + + if (n == 0) { + Eterm *hp; + hp = erts_produce_heap(factory, 2, 0); + hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(0); + hp[1] = 0; + + return make_hashmap(hp); + } + + /* sort and compact array (remove non-unique entries) */ + qsort(hxns, n, sizeof(hxnode_t), (int (*)(const void *, const void *)) hxnodecmp); + + ix = 0, cx = 0; + while(ix < n - 1) { + if (hxns[ix].hx == hxns[ix+1].hx) { + + /* find region of equal hash values */ + jx = ix + 1; + while(jx < n && hxns[ix].hx == hxns[jx].hx) { jx++; } + /* find all correct keys from region + * (last in list but now hash sorted so we check highest id instead) */ + + /* resort with keys instead of hash value within region */ + + qsort(&hxns[ix], jx - ix, sizeof(hxnode_t), + (int (*)(const void *, const void *)) hxnodecmpkey); + + while(ix < jx) { + lx = ix; + while(++ix < jx && EQ(CAR(list_val(hxns[ix].val)), + CAR(list_val(hxns[lx].val)))) { + if (reject_dupkeys) + return THE_NON_VALUE; + + if (hxns[ix].i > hxns[lx].i) { + lx = ix; + } } - ks[idx] = kv[1]; - vs[idx] = kv[2]; - size++; + hxns[cx].hx = hxns[lx].hx; + hxns[cx].val = hxns[lx].val; + cx++; } - item = CDR(list_val(item)); + ix = jx; + continue; + } + if (ix > cx) { + hxns[cx].hx = hxns[ix].hx; + hxns[cx].val = hxns[ix].val; } + cx++; + ix++; + } - if (unused_size) { - /* the key tuple is embedded in the heap - * write a bignum to clear it. - */ - /* release values as normal since they are on the top of the heap */ + if (ix < n) { + hxns[cx].hx = hxns[ix].hx; + hxns[cx].val = hxns[ix].val; + cx++; + } - ks[size] = make_pos_bignum_header(unused_size - 1); - HRelease(BIF_P, vs + size + unused_size, vs + size); - } + if (cx > 1) { + /* recursive decompose array */ + res = hashmap_from_sorted_unique_array(factory, hxns, cx, 0); + } else { + Eterm *hp; - *thp = make_arityval(size); - mp->size = size; - BIF_RET(res); + /* we only have one item, either because n was 1 or + * because we hade multiples of the same key. + * + * hash value has been swizzled, need to drag it down to get the + * correct slot. */ + + hp = erts_produce_heap(factory, HAMT_HEAD_BITMAP_SZ(1), 0); + hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(1 << ((hxns[0].hx >> 0x1c) & 0xf)); + hp[1] = 1; + hp[2] = hxns[0].val; + res = make_hashmap(hp); } -error: + return res; +} - BIF_ERROR(BIF_P, BADARG); +static Eterm hashmap_from_sorted_unique_array(ErtsHeapFactory* factory, + hxnode_t *hxns, Uint n, int lvl) { + Eterm res = NIL; + Uint i,ix,jx,elems; + Uint32 sw, hx; + Eterm val; + hxnode_t *tmp; + DeclareTmpHeapNoproc(th,2); + UseTmpHeapNoproc(2); + ASSERT(lvl < 32); + ix = 0; + elems = 1; + while (ix < n - 1) { + if (hxns[ix].hx == hxns[ix+1].hx) { + jx = ix + 1; + while (jx < n && hxns[ix].hx == hxns[jx].hx) { jx++; } + tmp = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, ((jx - ix)) * sizeof(hxnode_t)); + + for(i = 0; i < jx - ix; i++) { + val = hxns[i + ix].val; + hx = hashmap_restore_hash(th, lvl + 8, CAR(list_val(val))); + swizzle32(sw,hx); + tmp[i].hx = sw; + tmp[i].val = val; + tmp[i].i = i; + tmp[i].skip = 1; + } + + qsort(tmp, jx - ix, sizeof(hxnode_t), (int (*)(const void *, const void *)) hxnodecmp); + + hxns[ix].skip = jx - ix; + hxns[ix].val = hashmap_from_sorted_unique_array(factory, tmp, jx - ix, lvl + 8); + erts_free(ERTS_ALC_T_TMP, (void *) tmp); + ix = jx; + if (ix < n) { elems++; } + continue; + } + hxns[ix].skip = 1; + elems++; + ix++; + } + + res = hashmap_from_chunked_array(factory, hxns, elems, n, !lvl); + + ERTS_FACTORY_HOLE_CHECK(factory); + + UnUseTmpHeapNoproc(2); + return res; } -/* maps:is_key/2 - */ +#define HALLOC_EXTRA 200 +static Eterm hashmap_from_chunked_array(ErtsHeapFactory *factory, hxnode_t *hxns, Uint n, + Uint size, int is_root) { + Uint ix, d, dn, dc, slot, elems; + Uint32 v, vp, vn, hdr; + Uint bp, sz; + DECLARE_ESTACK(stack); + Eterm res = NIL, *hp = NULL, *nhp; -BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) { - if (is_map(BIF_ARG_2)) { - Eterm *ks, key; - map_t *mp; - Uint n,i; - mp = (map_t*)map_val(BIF_ARG_2); - key = BIF_ARG_1; - n = map_get_size(mp); - ks = map_get_keys(mp); + /* if we get here with only one element then + * we have eight levels of collisions + */ - if (n == 0) - BIF_RET(am_false); + if (n == 1) { + res = hxns[0].val; + v = hxns[0].hx; + for (d = 7; d > 0; d--) { + slot = maskval(v,d); + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA); + hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << slot); + hp[1] = res; + res = make_hashmap(hp); + } - if (is_immed(key)) { - for( i = 0; i < n; i++) { - if (ks[i] == key) { - BIF_RET(am_true); - } + slot = maskval(v,0); + hp = erts_produce_heap(factory, (is_root ? 3 : 2), 0); + + if (is_root) { + hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(1 << slot); + hp[1] = size; + hp[2] = res; + } else { + hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << slot); + hp[1] = res; + } + return make_hashmap(hp); + } + + /* push initial nodes on the stack, + * this is the starting depth */ + + ix = 0; + d = 0; + vp = hxns[ix].hx; + v = hxns[ix + hxns[ix].skip].hx; + + ASSERT(vp > v); + slot = maskval(vp,d); + + while(slot == maskval(v,d)) { + ESTACK_PUSH(stack, 1 << slot); + d++; + slot = maskval(vp,d); + } + + res = hxns[ix].val; + + if (hxns[ix].skip > 1) { + dc = 7; + /* build collision nodes */ + while (dc > d) { + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA); + hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(vp,dc)); + hp[1] = res; + res = make_hashmap(hp); + dc--; + } + } + + ESTACK_PUSH2(stack,res,1 << slot); + + /* all of the other nodes .. */ + elems = n - 2; /* remove first and last elements */ + while(elems--) { + hdr = ESTACK_POP(stack); + ix = ix + hxns[ix].skip; + + /* determine if node or subtree should be built by looking + * at the next value. */ + + vn = hxns[ix + hxns[ix].skip].hx; + dn = cdepth(v,vn); + ASSERT(v > vn); + + res = hxns[ix].val; + + if (hxns[ix].skip > 1) { + int wat = (d > dn) ? d : dn; + dc = 7; + /* build collision nodes */ + while (dc > wat) { + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA); + hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(v,dc)); + hp[1] = res; + res = make_hashmap(hp); + dc--; } } - for( i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - BIF_RET(am_true); + /* next depth is higher (implies collision) */ + if (d < dn) { + /* hdr is the popped one initially */ + while(d < dn) { + slot = maskval(v, d); + bp = 1 << slot; + ESTACK_PUSH(stack, hdr | bp); + d++; + hdr = 0; /* clear hdr for all other collisions */ + } + + slot = maskval(v, d); + bp = 1 << slot; + /* no more collisions */ + ESTACK_PUSH2(stack,res,bp); + } else if (d == dn) { + /* no collisions at all */ + slot = maskval(v, d); + bp = 1 << slot; + ESTACK_PUSH2(stack,res,hdr | bp); + } else { + /* dn < n, we have a drop and we are done + * build nodes and subtree */ + while (dn != d) { + slot = maskval(v, d); + bp = 1 << slot; + /* OR bitposition before sz calculation to handle + * redundant collisions */ + hdr |= bp; + sz = hashmap_bitcount(hdr); + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(sz), HALLOC_EXTRA); + nhp = hp; + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr); + *hp++ = res; sz--; + while (sz--) { *hp++ = ESTACK_POP(stack); } + ASSERT((hp - nhp) < 18); + res = make_hashmap(nhp); + + /* we need to pop the next hdr and push if we don't need it */ + + hdr = ESTACK_POP(stack); + d--; } + ESTACK_PUSH2(stack,res,hdr); } - BIF_RET(am_false); + + vp = v; + v = vn; + d = dn; + ERTS_FACTORY_HOLE_CHECK(factory); } - BIF_ERROR(BIF_P, BADARG); + + /* v and vp are reused from above */ + dn = cdepth(vp,v); + ix = ix + hxns[ix].skip; + res = hxns[ix].val; + + if (hxns[ix].skip > 1) { + dc = 7; + /* build collision nodes */ + while (dc > dn) { + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA); + hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(v,dc)); + hp[1] = res; + res = make_hashmap(hp); + dc--; + } + } + + hdr = ESTACK_POP(stack); + /* pop remaining subtree if any */ + while (dn) { + slot = maskval(v, dn); + bp = 1 << slot; + /* OR bitposition before sz calculation to handle + * redundant collisions */ + hdr |= bp; + sz = hashmap_bitcount(hdr); + hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(sz), HALLOC_EXTRA); + nhp = hp; + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr); + *hp++ = res; sz--; + + while (sz--) { *hp++ = ESTACK_POP(stack); } + res = make_hashmap(nhp); + hdr = ESTACK_POP(stack); + dn--; + } + + /* and finally the root .. */ + + slot = maskval(v, dn); + bp = 1 << slot; + hdr |= bp; + sz = hashmap_bitcount(hdr); + hp = erts_produce_heap(factory, sz + /* hdr + item */ (is_root ? 2 : 1), 0); + nhp = hp; + + if (is_root) { + *hp++ = (hdr == 0xffff) ? MAP_HEADER_HAMT_HEAD_ARRAY : MAP_HEADER_HAMT_HEAD_BITMAP(hdr); + *hp++ = size; + } else { + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr); + } + + *hp++ = res; sz--; + while (sz--) { *hp++ = ESTACK_POP(stack); } + + res = make_hashmap(nhp); + + ASSERT(ESTACK_COUNT(stack) == 0); + DESTROY_ESTACK(stack); + ERTS_FACTORY_HOLE_CHECK(factory); + return res; } +#undef HALLOC_EXTRA -/* maps:keys/1 - */ +static int hxnodecmpkey(hxnode_t *a, hxnode_t *b) { + Sint c = CMP_TERM(CAR(list_val(a->val)), CAR(list_val(b->val))); +#if ERTS_SIZEOF_ETERM <= SIZEOF_INT + return c; +#else + return c > 0 ? 1 : (c < 0 ? -1 : 0); +#endif +} + +static int hxnodecmp(hxnode_t *a, hxnode_t *b) { + if (a->hx < b->hx) + return 1; + else if (a->hx == b->hx) + return 0; + else + return -1; +} + +/* maps:is_key/2 */ + +BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + BIF_RET(erts_maps_get(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* maps:keys/1 */ BIF_RETTYPE maps_keys_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { + if (is_flatmap(BIF_ARG_1)) { Eterm *hp, *ks, res = NIL; - map_t *mp; + flatmap_t *mp; Uint n; - mp = (map_t*)map_val(BIF_ARG_1); - n = map_get_size(mp); + mp = (flatmap_t*)flatmap_val(BIF_ARG_1); + n = flatmap_get_size(mp); if (n == 0) BIF_RET(res); hp = HAlloc(BIF_P, (2 * n)); - ks = map_get_keys(mp); + ks = flatmap_get_keys(mp); while(n--) { res = CONS(hp, ks[n], res); hp += 2; } BIF_RET(res); + } else if (is_hashmap(BIF_ARG_1)) { + BIF_RET(hashmap_keys(BIF_P, BIF_ARG_1)); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); } -/* maps:merge/2 - */ +/* maps:merge/2 */ BIF_RETTYPE maps_merge_2(BIF_ALIST_2) { - if (is_map(BIF_ARG_1) && is_map(BIF_ARG_2)) { - Eterm *hp,*thp; - Eterm tup; - Eterm *ks,*vs,*ks1,*vs1,*ks2,*vs2; - map_t *mp1,*mp2,*mp_new; - Uint n1,n2,i1,i2,need,unused_size=0; - int c = 0; - - mp1 = (map_t*)map_val(BIF_ARG_1); - mp2 = (map_t*)map_val(BIF_ARG_2); - n1 = map_get_size(mp1); - n2 = map_get_size(mp2); - - need = MAP_HEADER_SIZE + 1 + 2*(n1 + n2); - - hp = HAlloc(BIF_P, need); - thp = hp; - tup = make_tuple(thp); - ks = hp + 1; hp += 1 + n1 + n2; - mp_new = (map_t*)hp; hp += MAP_HEADER_SIZE; - vs = hp; hp += n1 + n2; - - mp_new->thing_word = MAP_HEADER; - mp_new->size = 0; - mp_new->keys = tup; - - i1 = 0; i2 = 0; - ks1 = map_get_keys(mp1); - vs1 = map_get_values(mp1); - ks2 = map_get_keys(mp2); - vs2 = map_get_values(mp2); - - while(i1 < n1 && i2 < n2) { - c = CMP_TERM(ks1[i1],ks2[i2]); - if ( c == 0) { - /* use righthand side arguments map value, - * but advance both maps */ - *ks++ = ks2[i2]; - *vs++ = vs2[i2]; - i1++, i2++, unused_size++; - } else if ( c < 0) { - *ks++ = ks1[i1]; - *vs++ = vs1[i1]; - i1++; - } else { - *ks++ = ks2[i2]; - *vs++ = vs2[i2]; - i2++; - } + if (is_flatmap(BIF_ARG_1)) { + if (is_flatmap(BIF_ARG_2)) { + BIF_RET(flatmap_merge(BIF_P, BIF_ARG_1, BIF_ARG_2)); + } else if (is_hashmap(BIF_ARG_2)) { + /* Will always become a tree */ + BIF_RET(map_merge_mixed(BIF_P, BIF_ARG_1, BIF_ARG_2, 0)); } + BIF_P->fvalue = BIF_ARG_2; + } else if (is_hashmap(BIF_ARG_1)) { + if (is_hashmap(BIF_ARG_2)) { + BIF_RET(hashmap_merge(BIF_P, BIF_ARG_1, BIF_ARG_2)); + } else if (is_flatmap(BIF_ARG_2)) { + /* Will always become a tree */ + BIF_RET(map_merge_mixed(BIF_P, BIF_ARG_2, BIF_ARG_1, 1)); + } + BIF_P->fvalue = BIF_ARG_2; + } else { + BIF_P->fvalue = BIF_ARG_1; + } + BIF_ERROR(BIF_P, BADMAP); +} - /* copy remaining */ - while (i1 < n1) { +static Eterm flatmap_merge(Process *p, Eterm nodeA, Eterm nodeB) { + Eterm *hp,*thp; + Eterm tup; + Eterm *ks,*vs,*ks1,*vs1,*ks2,*vs2; + flatmap_t *mp1,*mp2,*mp_new; + Uint n,n1,n2,i1,i2,need,unused_size=0; + Sint c = 0; + + mp1 = (flatmap_t*)flatmap_val(nodeA); + mp2 = (flatmap_t*)flatmap_val(nodeB); + n1 = flatmap_get_size(mp1); + n2 = flatmap_get_size(mp2); + + need = MAP_HEADER_FLATMAP_SZ + 1 + 2 * (n1 + n2); + + hp = HAlloc(p, need); + thp = hp; + tup = make_tuple(thp); + ks = hp + 1; hp += 1 + n1 + n2; + mp_new = (flatmap_t*)hp; hp += MAP_HEADER_FLATMAP_SZ; + vs = hp; hp += n1 + n2; + + mp_new->thing_word = MAP_HEADER_FLATMAP; + mp_new->size = 0; + mp_new->keys = tup; + + i1 = 0; i2 = 0; + ks1 = flatmap_get_keys(mp1); + vs1 = flatmap_get_values(mp1); + ks2 = flatmap_get_keys(mp2); + vs2 = flatmap_get_values(mp2); + + while(i1 < n1 && i2 < n2) { + c = CMP_TERM(ks1[i1],ks2[i2]); + if (c == 0) { + /* use righthand side arguments map value, + * but advance both maps */ + *ks++ = ks2[i2]; + *vs++ = vs2[i2]; + i1++, i2++, unused_size++; + } else if (c < 0) { *ks++ = ks1[i1]; *vs++ = vs1[i1]; i1++; - } - - while (i2 < n2) { + } else { *ks++ = ks2[i2]; *vs++ = vs2[i2]; i2++; } + } - if (unused_size) { - /* the key tuple is embedded in the heap, write a bignum to clear it. - * - * release values as normal since they are on the top of the heap - * size = n1 + n1 - unused_size - */ + /* copy remaining */ + while (i1 < n1) { + *ks++ = ks1[i1]; + *vs++ = vs1[i1]; + i1++; + } - *ks = make_pos_bignum_header(unused_size - 1); - HRelease(BIF_P, vs + unused_size, vs); - } + while (i2 < n2) { + *ks++ = ks2[i2]; + *vs++ = vs2[i2]; + i2++; + } - mp_new->size = n1 + n2 - unused_size; - *thp = make_arityval(n1 + n2 - unused_size); + if (unused_size) { + /* the key tuple is embedded in the heap, write a bignum to clear it. + * + * release values as normal since they are on the top of the heap + * size = n1 + n1 - unused_size + */ - BIF_RET(make_map(mp_new)); + *ks = make_pos_bignum_header(unused_size - 1); + HRelease(p, vs + unused_size, vs); } - BIF_ERROR(BIF_P, BADARG); -} -/* maps:new/2 - */ -BIF_RETTYPE maps_new_0(BIF_ALIST_0) { - Eterm* hp; - Eterm tup; - map_t *mp; + n = n1 + n2 - unused_size; + *thp = make_arityval(n); + mp_new->size = n; - hp = HAlloc(BIF_P, (MAP_HEADER_SIZE + 1)); - tup = make_tuple(hp); - *hp++ = make_arityval(0); + /* Reshape map to a hashmap if the map exceeds the limit */ - mp = (map_t*)hp; - mp->thing_word = MAP_HEADER; - mp->size = 0; - mp->keys = tup; + if (n > MAP_SMALL_MAP_LIMIT) { + Uint32 hx,sw; + Uint i; + Eterm res; + hxnode_t *hxns; + ErtsHeapFactory factory; - BIF_RET(make_map(mp)); -} + ks = flatmap_get_keys(mp_new); + vs = flatmap_get_values(mp_new); -/* maps:put/3 - */ + hp = HAlloc(p, 2 * n); -Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { - Sint n,i; - Sint c = 0; - Eterm* hp, *shp; - Eterm *ks,*vs, res, tup; - map_t *mp = (map_t*)map_val(map); + hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP,n * sizeof(hxnode_t)); - n = map_get_size(mp); + for (i = 0; i < n; i++) { + hx = hashmap_make_hash(ks[i]); + swizzle32(sw,hx); + hxns[i].hx = sw; + hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2; + hxns[i].skip = 1; + hxns[i].i = i; + } - if (n == 0) { - hp = HAlloc(p, MAP_HEADER_SIZE + 1 + 2); - tup = make_tuple(hp); - *hp++ = make_arityval(1); - *hp++ = key; - res = make_map(hp); - *hp++ = MAP_HEADER; - *hp++ = 1; - *hp++ = tup; - *hp++ = value; + factory.p = p; + res = hashmap_from_unsorted_array(&factory, hxns, n, 0); + + erts_free(ERTS_ALC_T_TMP, (void *) hxns); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); return res; } - ks = map_get_keys(mp); - vs = map_get_values(mp); + return make_flatmap(mp_new); +} + +static Eterm map_merge_mixed(Process *p, Eterm flat, Eterm tree, int swap_args) { + Eterm *ks, *vs, *hp, res; + flatmap_t *mp; + Uint n, i; + hxnode_t *hxns; + Uint32 sw, hx; + ErtsHeapFactory factory; + + /* convert flat to tree */ + + ASSERT(is_flatmap(flat)); + ASSERT(is_hashmap(tree)); + + mp = (flatmap_t*)flatmap_val(flat); + n = flatmap_get_size(mp); + + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + hp = HAlloc(p, 2 * n); + + hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(hxnode_t)); + + for (i = 0; i < n; i++) { + hx = hashmap_make_hash(ks[i]); + swizzle32(sw,hx); + hxns[i].hx = sw; + hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2; + hxns[i].skip = 1; + hxns[i].i = i; + } - /* only allocate for values, - * assume key-tuple will be intact + factory.p = p; + res = hashmap_from_unsorted_array(&factory, hxns, n, 0); + + erts_free(ERTS_ALC_T_TMP, (void *) hxns); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); + + return swap_args ? hashmap_merge(p, tree, res) : hashmap_merge(p, res, tree); +} + +#define HALLOC_EXTRA 200 + +static Eterm hashmap_merge(Process *p, Eterm nodeA, Eterm nodeB) { +#define PSTACK_TYPE struct HashmapMergePStackType + struct HashmapMergePStackType { + Eterm *srcA, *srcB; + Uint32 abm, bbm, rbm; /* node bitmaps */ + int keepA; + int ix; + Eterm array[16]; + }; + PSTACK_DECLARE(s, 4); + struct HashmapMergePStackType* sp = PSTACK_PUSH(s); + Eterm *hp, *nhp; + Eterm hdrA, hdrB; + Uint32 ahx, bhx; + Uint size; /* total key-value counter */ + int keepA = 0; + unsigned int lvl = 0; + DeclareTmpHeap(th,2,p); + Eterm res = THE_NON_VALUE; + UseTmpHeap(2,p); + + /* + * Strategy: Do depth-first traversal of both trees (at the same time) + * and merge each pair of nodes. */ - hp = HAlloc(p, MAP_HEADER_SIZE + n); - shp = hp; /* save hp, used if optimistic update fails */ - res = make_map(hp); - *hp++ = MAP_HEADER; - *hp++ = n; - *hp++ = mp->keys; - - if (is_immed(key)) { - for( i = 0; i < n; i ++) { - if (ks[i] == key) { - *hp++ = value; - vs++; - c = 1; + { + hashmap_head_t* a = (hashmap_head_t*) hashmap_val(nodeA); + hashmap_head_t* b = (hashmap_head_t*) hashmap_val(nodeB); + size = a->size + b->size; + } + +recurse: + + if (primary_tag(nodeA) == TAG_PRIMARY_BOXED && + primary_tag(nodeB) == TAG_PRIMARY_LIST) { + /* Avoid implementing this combination by switching places */ + Eterm tmp = nodeA; + nodeA = nodeB; + nodeB = tmp; + keepA = !keepA; + } + + switch (primary_tag(nodeA)) { + case TAG_PRIMARY_LIST: { + sp->srcA = list_val(nodeA); + switch (primary_tag(nodeB)) { + case TAG_PRIMARY_LIST: { /* LEAF + LEAF */ + sp->srcB = list_val(nodeB); + + if (EQ(CAR(sp->srcA), CAR(sp->srcB))) { + --size; + res = keepA ? nodeA : nodeB; } else { - *hp++ = *vs++; + ahx = hashmap_restore_hash(th, lvl, CAR(sp->srcA)); + bhx = hashmap_restore_hash(th, lvl, CAR(sp->srcB)); + sp->abm = 1 << hashmap_index(ahx); + sp->bbm = 1 << hashmap_index(bhx); + + sp->srcA = &nodeA; + sp->srcB = &nodeB; } + break; } - } else { - for( i = 0; i < n; i ++) { - if (EQ(ks[i], key)) { - *hp++ = value; - vs++; - c = 1; - } else { - *hp++ = *vs++; + case TAG_PRIMARY_BOXED: { /* LEAF + NODE */ + sp->srcB = boxed_val(nodeB); + ASSERT(is_header(*sp->srcB)); + hdrB = *sp->srcB++; + + ahx = hashmap_restore_hash(th, lvl, CAR(sp->srcA)); + sp->abm = 1 << hashmap_index(ahx); + sp->srcA = &nodeA; + switch(hdrB & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + sp->srcB++; + sp->bbm = 0xffff; + break; + + case HAMT_SUBTAG_HEAD_BITMAP: sp->srcB++; + case HAMT_SUBTAG_NODE_BITMAP: + sp->bbm = MAP_HEADER_VAL(hdrB); + break; + + default: + erl_exit(1, "bad header tag %ld\r\n", *sp->srcB & _HEADER_MAP_SUBTAG_MASK); + break; } + break; + } + default: + erl_exit(1, "bad primary tag %ld\r\n", nodeB); } + break; } + case TAG_PRIMARY_BOXED: { /* NODE + NODE */ + sp->srcA = boxed_val(nodeA); + hdrA = *sp->srcA++; + ASSERT(is_header(hdrA)); + switch (hdrA & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: { + sp->srcA++; + ASSERT(primary_tag(nodeB) == TAG_PRIMARY_BOXED); + sp->abm = 0xffff; + sp->srcB = boxed_val(nodeB); + hdrB = *sp->srcB++; + ASSERT(is_header(hdrB)); + switch (hdrB & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + sp->srcB++; + sp->bbm = 0xffff; + break; + case HAMT_SUBTAG_HEAD_BITMAP: sp->srcB++; + case HAMT_SUBTAG_NODE_BITMAP: + sp->bbm = MAP_HEADER_VAL(hdrB); + break; + default: + erl_exit(1, "bad header tag %ld\r\n", *sp->srcB & _HEADER_MAP_SUBTAG_MASK); + } + break; + } + case HAMT_SUBTAG_HEAD_BITMAP: sp->srcA++; + case HAMT_SUBTAG_NODE_BITMAP: { + ASSERT(primary_tag(nodeB) == TAG_PRIMARY_BOXED); + sp->abm = MAP_HEADER_VAL(hdrA); + sp->srcB = boxed_val(nodeB); + hdrB = *sp->srcB++; + ASSERT(is_header(hdrB)); + switch (hdrB & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + sp->srcB++; + sp->bbm = 0xffff; + break; + case HAMT_SUBTAG_HEAD_BITMAP: sp->srcB++; + case HAMT_SUBTAG_NODE_BITMAP: + sp->bbm = MAP_HEADER_VAL(hdrB); + break; - if (c) - return res; + default: + erl_exit(1, "bad header tag %ld\r\n", *sp->srcB & _HEADER_MAP_SUBTAG_MASK); + } + break; + } + default: + erl_exit(1, "bad primary tag %ld\r\n", nodeA); + } + break; + } + default: + erl_exit(1, "bad primary tag %ld\r\n", nodeA); + } - /* need to make a new tuple, - * use old hp since it needs to be recreated anyway. - */ - tup = make_tuple(shp); - *shp++ = make_arityval(n+1); + for (;;) { + if (is_value(res)) { /* We have a complete (sub-)tree or leaf */ + if (lvl == 0) + break; - hp = HAlloc(p, 3 + n + 1); - res = make_map(hp); - *hp++ = MAP_HEADER; - *hp++ = n + 1; - *hp++ = tup; + /* Pop from stack and continue build parent node */ + lvl--; + sp = PSTACK_POP(s); + sp->array[sp->ix++] = res; + res = THE_NON_VALUE; + if (sp->rbm) { + sp->srcA++; + sp->srcB++; + keepA = sp->keepA; + } + } else { /* Start build a node */ + sp->ix = 0; + sp->rbm = sp->abm | sp->bbm; + ASSERT(!(sp->rbm == 0 && lvl > 0)); + } - ks = map_get_keys(mp); - vs = map_get_values(mp); + while (sp->rbm) { + Uint32 next = sp->rbm & (sp->rbm-1); + Uint32 bit = sp->rbm ^ next; + sp->rbm = next; + if (sp->abm & bit) { + if (sp->bbm & bit) { + /* Bit clash. Push and resolve by recursive merge */ + if (sp->rbm) { + sp->keepA = keepA; + } + nodeA = *sp->srcA; + nodeB = *sp->srcB; + lvl++; + sp = PSTACK_PUSH(s); + goto recurse; + } else { + sp->array[sp->ix++] = *sp->srcA++; + } + } else { + ASSERT(sp->bbm & bit); + sp->array[sp->ix++] = *sp->srcB++; + } + } - ASSERT(n >= 0); + ASSERT(sp->ix == hashmap_bitcount(sp->abm | sp->bbm)); + if (lvl == 0) { + nhp = HAllocX(p, HAMT_HEAD_BITMAP_SZ(sp->ix), HALLOC_EXTRA); + hp = nhp; + *hp++ = (sp->ix == 16 ? MAP_HEADER_HAMT_HEAD_ARRAY + : MAP_HEADER_HAMT_HEAD_BITMAP(sp->abm | sp->bbm)); + *hp++ = size; + } else { + nhp = HAllocX(p, HAMT_NODE_BITMAP_SZ(sp->ix), HALLOC_EXTRA); + hp = nhp; + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(sp->abm | sp->bbm); + } + memcpy(hp, sp->array, sp->ix * sizeof(Eterm)); + res = make_boxed(nhp); + } + PSTACK_DESTROY(s); + UnUseTmpHeap(2,p); + return res; +} - /* copy map in order */ - while (n && ((c = CMP_TERM(*ks, key)) < 0)) { - *shp++ = *ks++; - *hp++ = *vs++; - n--; +static int hash_cmp(Uint32 ha, Uint32 hb) +{ + int i; + for (i=0; i<8; i++) { + int cmp = (int)(ha & 0xF) - (int)(hb & 0xF); + if (cmp) + return cmp; + ha >>= 4; + hb >>= 4; } + return 0; +} - *shp++ = key; - *hp++ = value; +int hashmap_key_hash_cmp(Eterm* ap, Eterm* bp) +{ + unsigned int lvl = 0; + DeclareTmpHeapNoproc(th,2); + UseTmpHeapNoproc(2); + + if (ap && bp) { + ASSERT(CMP_TERM(CAR(ap), CAR(bp)) != 0); + for (;;) { + Uint32 ha = hashmap_restore_hash(th, lvl, CAR(ap)); + Uint32 hb = hashmap_restore_hash(th, lvl, CAR(bp)); + int cmp = hash_cmp(ha, hb); + if (cmp) { + UnUseTmpHeapNoproc(2); + return cmp; + } + lvl += 8; + } + } + UnUseTmpHeapNoproc(2); + return ap ? -1 : 1; +} - ASSERT(n >= 0); +/* maps:new/0 */ - while(n--) { - *shp++ = *ks++; - *hp++ = *vs++; - } - /* we have one word remaining - * this will work out fine once we get the size word - * in the header. - */ - *shp = make_pos_bignum_header(0); - return res; +BIF_RETTYPE maps_new_0(BIF_ALIST_0) { + Eterm* hp; + Eterm tup; + flatmap_t *mp; + + hp = HAlloc(BIF_P, (MAP_HEADER_FLATMAP_SZ + 1)); + tup = make_tuple(hp); + *hp++ = make_arityval(0); + + mp = (flatmap_t*)hp; + mp->thing_word = MAP_HEADER_FLATMAP; + mp->size = 0; + mp->keys = tup; + + BIF_RET(make_flatmap(mp)); } +/* maps:put/3 */ + BIF_RETTYPE maps_put_3(BIF_ALIST_3) { if (is_map(BIF_ARG_3)) { BIF_RET(erts_maps_put(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3)); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_3; + BIF_ERROR(BIF_P, BADMAP); } -/* maps:remove/3 - */ +/* maps:remove/3 */ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { - Sint n; - Uint need; - Eterm *hp_start; - Eterm *thp, *mhp; - Eterm *ks, *vs, tup; - map_t *mp = (map_t*)map_val(map); + Uint32 hx; + if (is_flatmap(map)) { + Sint n; + Uint need; + Eterm *hp_start; + Eterm *thp, *mhp; + Eterm *ks, *vs, tup; + flatmap_t *mp = (flatmap_t*)flatmap_val(map); + + n = flatmap_get_size(mp); + + if (n == 0) { + *res = map; + return 1; + } - n = map_get_size(mp); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); - if (n == 0) { - *res = map; - return 1; - } + /* Assume key exists. + * Release allocated if it didn't. + * Allocate key tuple first. + */ - ks = map_get_keys(mp); - vs = map_get_values(mp); + need = n + 1 - 1 + 3 + n - 1; /* tuple - 1 + map - 1 */ + hp_start = HAlloc(p, need); + thp = hp_start; + mhp = thp + n; /* offset with tuple heap size */ - /* Assume key exists. - * Release allocated if it didn't. - * Allocate key tuple first. - */ + tup = make_tuple(thp); + *thp++ = make_arityval(n - 1); - need = n + 1 - 1 + 3 + n - 1; /* tuple - 1 + map - 1 */ - hp_start = HAlloc(p, need); - thp = hp_start; - mhp = thp + n; /* offset with tuple heap size */ + *res = make_flatmap(mhp); + *mhp++ = MAP_HEADER_FLATMAP; + *mhp++ = n - 1; + *mhp++ = tup; - tup = make_tuple(thp); - *thp++ = make_arityval(n - 1); - - *res = make_map(mhp); - *mhp++ = MAP_HEADER; - *mhp++ = n - 1; - *mhp++ = tup; - - if (is_immed(key)) { - while (1) { - if (*ks == key) { - goto found_key; - } else if (--n) { - *mhp++ = *vs++; - *thp++ = *ks++; - } else - break; - } - } else { - while(1) { - if (EQ(*ks, key)) { - goto found_key; - } else if (--n) { - *mhp++ = *vs++; - *thp++ = *ks++; - } else - break; + if (is_immed(key)) { + while (1) { + if (*ks == key) { + goto found_key; + } else if (--n) { + *mhp++ = *vs++; + *thp++ = *ks++; + } else + break; + } + } else { + while(1) { + if (EQ(*ks, key)) { + goto found_key; + } else if (--n) { + *mhp++ = *vs++; + *thp++ = *ks++; + } else + break; + } } - } - /* Not found, remove allocated memory - * and return previous map. - */ - HRelease(p, hp_start + need, hp_start); + /* Not found, remove allocated memory + * and return previous map. + */ + HRelease(p, hp_start + need, hp_start); - *res = map; - return 1; + *res = map; + return 1; found_key: - /* Copy rest of keys and values */ - if (--n) { - sys_memcpy(mhp, vs+1, n*sizeof(Eterm)); - sys_memcpy(thp, ks+1, n*sizeof(Eterm)); + /* Copy rest of keys and values */ + if (--n) { + sys_memcpy(mhp, vs+1, n*sizeof(Eterm)); + sys_memcpy(thp, ks+1, n*sizeof(Eterm)); + } + return 1; } + ASSERT(is_hashmap(map)); + hx = hashmap_make_hash(key); + *res = hashmap_delete(p, hx, key, map); return 1; } @@ -683,32 +1490,32 @@ BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { BIF_RET(res); } } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); } -/* maps:update/3 - */ - int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) { + Uint32 hx; + if (is_flatmap(map)) { Sint n,i; Eterm* hp,*shp; Eterm *ks,*vs; - map_t *mp = (map_t*)map_val(map); + flatmap_t *mp = (flatmap_t*)flatmap_val(map); - if ((n = map_get_size(mp)) == 0) { + if ((n = flatmap_get_size(mp)) == 0) { return 0; } - ks = map_get_keys(mp); - vs = map_get_values(mp); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); /* only allocate for values, * assume key-tuple will be intact */ - hp = HAlloc(p, MAP_HEADER_SIZE + n); + hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + n); shp = hp; - *hp++ = MAP_HEADER; + *hp++ = MAP_HEADER_FLATMAP; *hp++ = n; *hp++ = mp->keys; @@ -730,7 +1537,7 @@ int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) } } - HRelease(p, shp + MAP_HEADER_SIZE + n, shp); + HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp); return 0; found_key: @@ -738,56 +1545,942 @@ found_key: vs++; if (++i < n) sys_memcpy(hp, vs, (n - i)*sizeof(Eterm)); - *res = make_map(shp); + *res = make_flatmap(shp); + return 1; + } + + ASSERT(is_hashmap(map)); + hx = hashmap_make_hash(key); + *res = erts_hashmap_insert(p, hx, key, value, map, 1); + if (is_value(*res)) return 1; + + return 0; +} + +Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { + Uint32 hx; + Eterm res; + if (is_flatmap(map)) { + Sint n,i; + Sint c = 0; + Eterm* hp, *shp; + Eterm *ks, *vs, tup; + flatmap_t *mp = (flatmap_t*)flatmap_val(map); + + n = flatmap_get_size(mp); + + if (n == 0) { + hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + 1 + 2); + tup = make_tuple(hp); + *hp++ = make_arityval(1); + *hp++ = key; + res = make_flatmap(hp); + *hp++ = MAP_HEADER_FLATMAP; + *hp++ = 1; + *hp++ = tup; + *hp++ = value; + + return res; + } + + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + /* only allocate for values, + * assume key-tuple will be intact + */ + + hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + n); + shp = hp; /* save hp, used if optimistic update fails */ + res = make_flatmap(hp); + *hp++ = MAP_HEADER_FLATMAP; + *hp++ = n; + *hp++ = mp->keys; + + if (is_immed(key)) { + for( i = 0; i < n; i ++) { + if (ks[i] == key) { + *hp++ = value; + vs++; + c = 1; + } else { + *hp++ = *vs++; + } + } + } else { + for( i = 0; i < n; i ++) { + if (EQ(ks[i], key)) { + *hp++ = value; + vs++; + c = 1; + } else { + *hp++ = *vs++; + } + } + } + + if (c) + return res; + + /* the map will grow */ + + if (n >= MAP_SMALL_MAP_LIMIT) { + HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + res = erts_hashmap_from_ks_and_vs_extra(p,ks,vs,n,key,value); + + return res; + } + + /* still a small map. need to make a new tuple, + * use old hp since it needs to be recreated anyway. */ + + tup = make_tuple(shp); + *shp++ = make_arityval(n+1); + + hp = HAlloc(p, 3 + n + 1); + res = make_flatmap(hp); + *hp++ = MAP_HEADER_FLATMAP; + *hp++ = n + 1; + *hp++ = tup; + + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + ASSERT(n >= 0); + + /* copy map in order */ + while (n && ((c = CMP_TERM(*ks, key)) < 0)) { + *shp++ = *ks++; + *hp++ = *vs++; + n--; + } + + *shp++ = key; + *hp++ = value; + + ASSERT(n >= 0); + + while(n--) { + *shp++ = *ks++; + *hp++ = *vs++; + } + /* we have one word remaining + * this will work out fine once we get the size word + * in the header. + */ + *shp = make_pos_bignum_header(0); + return res; + } + ASSERT(is_hashmap(map)); + + hx = hashmap_make_hash(key); + res = erts_hashmap_insert(p, hx, key, value, map, 0); + ASSERT(is_hashmap(res)); + + return res; } +/* maps:update/3 */ + BIF_RETTYPE maps_update_3(BIF_ALIST_3) { - if (is_map(BIF_ARG_3)) { + if (is_not_map(BIF_ARG_3)) { + BIF_P->fvalue = BIF_ARG_3; + BIF_ERROR(BIF_P, BADMAP); + } else { Eterm res; if (erts_maps_update(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &res)) { BIF_RET(res); } + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADKEY); } - BIF_ERROR(BIF_P, BADARG); } -/* maps:values/1 - */ +/* maps:values/1 */ BIF_RETTYPE maps_values_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { + if (is_flatmap(BIF_ARG_1)) { Eterm *hp, *vs, res = NIL; - map_t *mp; + flatmap_t *mp; Uint n; - mp = (map_t*)map_val(BIF_ARG_1); - n = map_get_size(mp); + mp = (flatmap_t*)flatmap_val(BIF_ARG_1); + n = flatmap_get_size(mp); if (n == 0) BIF_RET(res); hp = HAlloc(BIF_P, (2 * n)); - vs = map_get_values(mp); + vs = flatmap_get_values(mp); while(n--) { res = CONS(hp, vs[n], res); hp += 2; } BIF_RET(res); + } else if (is_hashmap(BIF_ARG_1)) { + BIF_RET(hashmap_values(BIF_P, BIF_ARG_1)); } - BIF_ERROR(BIF_P, BADARG); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); +} + +static Eterm hashmap_to_list(Process *p, Eterm node) { + DECLARE_WSTACK(stack); + Eterm *hp, *kv; + Eterm res = NIL; + + hp = HAlloc(p, hashmap_size(node) * (2 + 3)); + hashmap_iterator_init(&stack, node, 0); + while ((kv=hashmap_iterator_next(&stack)) != NULL) { + Eterm tup = TUPLE2(hp, CAR(kv), CDR(kv)); + hp += 3; + res = CONS(hp, tup, res); + hp += 2; + } + DESTROY_WSTACK(stack); + return res; +} + +void hashmap_iterator_init(ErtsWStack* s, Eterm node, int reverse) { + Eterm hdr = *hashmap_val(node); + Uint sz; + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + sz = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + break; + default: + erl_exit(1, "bad header"); + } + + WSTACK_PUSH3((*s), (UWord)THE_NON_VALUE, /* end marker */ + (UWord)(!reverse ? 0 : sz+1), + (UWord)node); +} + +Eterm* hashmap_iterator_next(ErtsWStack* s) { + Eterm node, *ptr, hdr; + Uint32 sz; + Uint idx; + + for (;;) { + ASSERT(!WSTACK_ISEMPTY((*s))); + node = (Eterm) WSTACK_POP((*s)); + if (is_non_value(node)) { + return NULL; + } + idx = (Uint) WSTACK_POP((*s)); + for (;;) { + ASSERT(is_boxed(node)); + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ptr++; + sz = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + ptr++; + case HAMT_SUBTAG_NODE_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(sz < 17); + break; + default: + erl_exit(1, "bad header"); + } + + idx++; + + if (idx <= sz) { + WSTACK_PUSH2((*s), (UWord)idx, (UWord)node); + + if (is_list(ptr[idx])) { + return list_val(ptr[idx]); + } + ASSERT(is_boxed(ptr[idx])); + node = ptr[idx]; + idx = 0; + } + else + break; /* and pop parent node */ + } + } +} + +Eterm* hashmap_iterator_prev(ErtsWStack* s) { + Eterm node, *ptr, hdr; + Uint32 sz; + Uint idx; + + for (;;) { + ASSERT(!WSTACK_ISEMPTY((*s))); + node = (Eterm) WSTACK_POP((*s)); + if (is_non_value(node)) { + return NULL; + } + idx = (Uint) WSTACK_POP((*s)); + for (;;) { + ASSERT(is_boxed(node)); + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ptr++; + sz = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + ptr++; + case HAMT_SUBTAG_NODE_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(sz < 17); + break; + default: + erl_exit(1, "bad header"); + } + + if (idx > sz) + idx = sz; + else + idx--; + + if (idx >= 1) { + WSTACK_PUSH2((*s), (UWord)idx, (UWord)node); + + if (is_list(ptr[idx])) { + return list_val(ptr[idx]); + } + ASSERT(is_boxed(ptr[idx])); + node = ptr[idx]; + idx = 17; + } + else + break; /* and pop parent node */ + } + } +} + +const Eterm * +#if HALFWORD_HEAP +erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base) +#else +erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) +#endif +{ + Eterm *ptr, hdr, *res; + Uint ix, lvl = 0; + Uint32 hval,bp; + DeclareTmpHeapNoproc(th,2); + UseTmpHeapNoproc(2); + + ASSERT(is_boxed(node)); + ptr = boxed_val_rel(node, map_base); + hdr = *ptr; + ASSERT(is_header(hdr)); + ASSERT(is_hashmap_header_head(hdr)); + ptr++; + + for (;;) { + hval = MAP_HEADER_VAL(hdr); + ix = hashmap_index(hx); + if (hval != 0xffff) { + bp = 1 << ix; + if (!(bp & hval)) { + /* not occupied */ + res = NULL; + break; + } + ix = hashmap_bitcount(hval & (bp - 1)); + } + node = ptr[ix+1]; + + if (is_list(node)) { /* LEAF NODE [K|V] */ + ptr = list_val_rel(node,map_base); + res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL; + break; + } + + hx = hashmap_shift_hash(th,hx,lvl,key); + + ASSERT(is_boxed(node)); + ptr = boxed_val_rel(node, map_base); + hdr = *ptr; + ASSERT(is_header(hdr)); + ASSERT(!is_hashmap_header_head(hdr)); + } + + UnUseTmpHeapNoproc(2); + return res; +} + +Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, + Eterm map, int is_update) { + Uint size, upsz; + Eterm *hp, res = THE_NON_VALUE; + DECLARE_ESTACK(stack); + if (erts_hashmap_insert_down(hx, key, map, &size, &upsz, &stack, is_update)) { + hp = HAlloc(p, size); + res = erts_hashmap_insert_up(hp, key, value, &upsz, &stack); + } + + DESTROY_ESTACK(stack); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); + ERTS_HOLE_CHECK(p); + + return res; +} + + +int erts_hashmap_insert_down(Uint32 hx, Eterm key, Eterm node, Uint *sz, + Uint *update_size, ErtsEStack *sp, int is_update) { + Eterm *ptr; + Eterm hdr, ckey; + Uint32 ix, cix, bp, hval, chx; + Uint slot, lvl = 0, clvl; + Uint size = 0, n = 0; + DeclareTmpHeapNoproc(th,2); + + *update_size = 1; + + UseTmpHeapNoproc(2); + for (;;) { + switch(primary_tag(node)) { + case TAG_PRIMARY_LIST: /* LEAF NODE [K|V] */ + ptr = list_val(node); + ckey = CAR(ptr); + if (EQ(ckey, key)) { + *update_size = 0; + goto unroll; + } + if (is_update) { + UnUseTmpHeapNoproc(2); + return 0; + } + goto insert_subnodes; + case TAG_PRIMARY_BOXED: + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ix = hashmap_index(hx); + hx = hashmap_shift_hash(th,hx,lvl,key); + size += HAMT_HEAD_ARRAY_SZ; + ESTACK_PUSH2(*sp, ix, node); + node = ptr[ix+2]; + break; + case HAMT_SUBTAG_NODE_BITMAP: + hval = MAP_HEADER_VAL(hdr); + ix = hashmap_index(hx); + bp = 1 << ix; + if (hval == 0xffff) { + slot = ix; + n = 16; + } else { + slot = hashmap_bitcount(hval & (bp - 1)); + n = hashmap_bitcount(hval); + } + + ESTACK_PUSH4(*sp, n, bp, slot, node); + + if (!(bp & hval)) { /* not occupied */ + if (is_update) { + UnUseTmpHeapNoproc(2); + return 0; + } + size += HAMT_NODE_BITMAP_SZ(n+1); + goto unroll; + } + + hx = hashmap_shift_hash(th,hx,lvl,key); + node = ptr[slot+1]; + ASSERT(HAMT_NODE_BITMAP_SZ(n) <= 17); + size += HAMT_NODE_BITMAP_SZ(n); + break; + + case HAMT_SUBTAG_HEAD_BITMAP: + hval = MAP_HEADER_VAL(hdr); + ix = hashmap_index(hx); + bp = 1 << ix; + slot = hashmap_bitcount(hval & (bp - 1)); + n = hashmap_bitcount(hval); + + ESTACK_PUSH4(*sp, n, bp, slot, node); + + /* occupied */ + if (bp & hval) { + hx = hashmap_shift_hash(th,hx,lvl,key); + node = ptr[slot+2]; + ASSERT(HAMT_HEAD_BITMAP_SZ(n) <= 18); + size += HAMT_HEAD_BITMAP_SZ(n); + break; + } + /* not occupied */ + if (is_update) { + UnUseTmpHeapNoproc(2); + return 0; + } + size += HAMT_HEAD_BITMAP_SZ(n+1); + goto unroll; + default: + erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); + break; + } + break; + default: + erl_exit(1, "bad primary tag %p\r\n", node); + break; + } + } +insert_subnodes: + clvl = lvl; + chx = hashmap_restore_hash(th,clvl,ckey); + size += HAMT_NODE_BITMAP_SZ(2); + ix = hashmap_index(hx); + cix = hashmap_index(chx); + + while (cix == ix) { + ESTACK_PUSH4(*sp, 0, 1 << ix, 0, MAP_HEADER_HAMT_NODE_BITMAP(0)); + size += HAMT_NODE_BITMAP_SZ(1); + hx = hashmap_shift_hash(th,hx,lvl,key); + chx = hashmap_shift_hash(th,chx,clvl,ckey); + ix = hashmap_index(hx); + cix = hashmap_index(chx); + } + ESTACK_PUSH3(*sp, cix, ix, node); + +unroll: + *sz = size + /* res cons */ 2; + UnUseTmpHeapNoproc(2); + return 1; +} + +Eterm erts_hashmap_insert_up(Eterm *hp, Eterm key, Eterm value, + Uint *update_size, ErtsEStack *sp) { + Eterm node, *ptr, hdr; + Eterm res; + Eterm *nhp = NULL; + Uint32 ix, cix, bp, hval; + Uint slot, n; + /* Needed for halfword */ + DeclareTmpHeapNoproc(fake,1); + UseTmpHeapNoproc(1); + + res = CONS(hp, key, value); hp += 2; + + do { + node = ESTACK_POP(*sp); + switch(primary_tag(node)) { + case TAG_PRIMARY_LIST: + ix = (Uint32) ESTACK_POP(*sp); + cix = (Uint32) ESTACK_POP(*sp); + + nhp = hp; + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP((1 << ix) | (1 << cix)); + if (ix < cix) { + *hp++ = res; + *hp++ = node; + } else { + *hp++ = node; + *hp++ = res; + } + res = make_hashmap(nhp); + break; + case TAG_PRIMARY_HEADER: + /* subnodes, fake it */ + *fake = node; + node = make_boxed(fake); + case TAG_PRIMARY_BOXED: + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + slot = (Uint) ESTACK_POP(*sp); + nhp = hp; + n = HAMT_HEAD_ARRAY_SZ - 2; + *hp++ = MAP_HEADER_HAMT_HEAD_ARRAY; ptr++; + *hp++ = (*ptr++) + *update_size; + while(n--) { *hp++ = *ptr++; } + nhp[slot+2] = res; + res = make_hashmap(nhp); + break; + case HAMT_SUBTAG_NODE_BITMAP: + slot = (Uint) ESTACK_POP(*sp); + bp = (Uint32) ESTACK_POP(*sp); + n = (Uint32) ESTACK_POP(*sp); + hval = MAP_HEADER_VAL(hdr); + nhp = hp; + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval | bp); ptr++; + + n -= slot; + while(slot--) { *hp++ = *ptr++; } + *hp++ = res; + if (hval & bp) { ptr++; n--; } + while(n--) { *hp++ = *ptr++; } + + res = make_hashmap(nhp); + break; + case HAMT_SUBTAG_HEAD_BITMAP: + slot = (Uint) ESTACK_POP(*sp); + bp = (Uint32) ESTACK_POP(*sp); + n = (Uint32) ESTACK_POP(*sp); + hval = MAP_HEADER_VAL(hdr); + nhp = hp; + *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(hval | bp); ptr++; + *hp++ = (*ptr++) + *update_size; + + n -= slot; + while(slot--) { *hp++ = *ptr++; } + *hp++ = res; + if (hval & bp) { ptr++; n--; } + while(n--) { *hp++ = *ptr++; } + + if ((hval | bp) == 0xffff) { + *nhp = MAP_HEADER_HAMT_HEAD_ARRAY; + } + res = make_hashmap(nhp); + break; + default: + erl_exit(1, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); + break; + } + break; + default: + erl_exit(1, "bad primary tag %x\r\n", primary_tag(node)); + break; + } + + } while(!ESTACK_ISEMPTY(*sp)); + + UnUseTmpHeapNoproc(1); + return res; +} + +static Eterm hashmap_keys(Process* p, Eterm node) { + DECLARE_WSTACK(stack); + hashmap_head_t* root; + Eterm *hp, *kv; + Eterm res = NIL; + + root = (hashmap_head_t*) boxed_val(node); + hp = HAlloc(p, root->size * 2); + hashmap_iterator_init(&stack, node, 0); + while ((kv=hashmap_iterator_next(&stack)) != NULL) { + res = CONS(hp, CAR(kv), res); + hp += 2; + } + DESTROY_WSTACK(stack); + return res; +} + +static Eterm hashmap_values(Process* p, Eterm node) { + DECLARE_WSTACK(stack); + hashmap_head_t* root; + Eterm *hp, *kv; + Eterm res = NIL; + + root = (hashmap_head_t*) boxed_val(node); + hp = HAlloc(p, root->size * 2); + hashmap_iterator_init(&stack, node, 0); + while ((kv=hashmap_iterator_next(&stack)) != NULL) { + res = CONS(hp, CDR(kv), res); + hp += 2; + } + DESTROY_WSTACK(stack); + return res; +} + +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { + Eterm *hp = NULL, *nhp = NULL, *hp_end = NULL; + Eterm *ptr; + Eterm hdr, res = map, node = map; + Uint32 ix, bp, hval; + Uint slot, lvl = 0; + Uint size = 0, n = 0; + DECLARE_ESTACK(stack); + DeclareTmpHeapNoproc(th,2); + UseTmpHeapNoproc(2); + + for (;;) { + switch(primary_tag(node)) { + case TAG_PRIMARY_LIST: + if (EQ(CAR(list_val(node)), key)) { + goto unroll; + } + goto not_found; + case TAG_PRIMARY_BOXED: + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ix = hashmap_index(hx); + hx = hashmap_shift_hash(th,hx,lvl,key); + size += HAMT_HEAD_ARRAY_SZ; + ESTACK_PUSH2(stack, ix, node); + node = ptr[ix+2]; + break; + case HAMT_SUBTAG_NODE_BITMAP: + hval = MAP_HEADER_VAL(hdr); + ix = hashmap_index(hx); + bp = 1 << ix; + if (hval == 0xffff) { + slot = ix; + n = 16; + } else if (bp & hval) { + slot = hashmap_bitcount(hval & (bp - 1)); + n = hashmap_bitcount(hval); + } else { + /* not occupied */ + goto not_found; + } + + ESTACK_PUSH4(stack, n, bp, slot, node); + + hx = hashmap_shift_hash(th,hx,lvl,key); + node = ptr[slot+1]; + ASSERT(HAMT_NODE_BITMAP_SZ(n) <= 17); + size += HAMT_NODE_BITMAP_SZ(n); + break; + + case HAMT_SUBTAG_HEAD_BITMAP: + hval = MAP_HEADER_VAL(hdr); + ix = hashmap_index(hx); + bp = 1 << ix; + slot = hashmap_bitcount(hval & (bp - 1)); + n = hashmap_bitcount(hval); + + ESTACK_PUSH4(stack, n, bp, slot, node); + + /* occupied */ + if (bp & hval) { + hx = hashmap_shift_hash(th,hx,lvl,key); + node = ptr[slot+2]; + ASSERT(HAMT_HEAD_BITMAP_SZ(n) <= 18); + size += HAMT_HEAD_BITMAP_SZ(n); + break; + } + /* not occupied */ + goto not_found; + default: + erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); + break; + } + break; + default: + erl_exit(1, "bad primary tag %p\r\n", node); + break; + } + } + +unroll: + /* the size is bounded and atleast one less than the previous size */ + size -= 1; + n = hashmap_size(map) - 1; + + if (n <= MAP_SMALL_MAP_LIMIT) { + DECLARE_WSTACK(wstack); + Eterm *kv, *ks, *vs; + flatmap_t *mp; + Eterm keys; + + DESTROY_ESTACK(stack); + + /* build flat structure */ + hp = HAlloc(p, 3 + 1 + (2 * n)); + keys = make_tuple(hp); + *hp++ = make_arityval(n); + ks = hp; + hp += n; + mp = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + vs = hp; + + mp->thing_word = MAP_HEADER_FLATMAP; + mp->size = n; + mp->keys = keys; + + hashmap_iterator_init(&wstack, map, 0); + + while ((kv=hashmap_iterator_next(&wstack)) != NULL) { + if (EQ(CAR(kv),key)) + continue; + *ks++ = CAR(kv); + *vs++ = CDR(kv); + } + + /* it cannot have multiple keys */ + erts_validate_and_sort_flatmap(mp); + + DESTROY_WSTACK(wstack); + UnUseTmpHeapNoproc(2); + return make_flatmap(mp); + } + + hp = HAlloc(p, size); + hp_end = hp + size; + res = THE_NON_VALUE; + + do { + node = ESTACK_POP(stack); + + /* all nodes are things */ + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ix = (Uint) ESTACK_POP(stack); + nhp = hp; + if (res == THE_NON_VALUE) { + n = 16; + n -= ix; + *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(0xffff ^ (1 << ix)); ptr++; + *hp++ = (*ptr++) - 1; + while(ix--) { *hp++ = *ptr++; } + ptr++; n--; + while(n--) { *hp++ = *ptr++; } + res = make_hashmap(nhp); + } else { + n = 16; + *hp++ = MAP_HEADER_HAMT_HEAD_ARRAY; ptr++; + *hp++ = (*ptr++) - 1; + while(n--) { *hp++ = *ptr++; } + nhp[ix+2] = res; + res = make_hashmap(nhp); + } + break; + case HAMT_SUBTAG_NODE_BITMAP: + slot = (Uint) ESTACK_POP(stack); + bp = (Uint32) ESTACK_POP(stack); + n = (Uint32) ESTACK_POP(stack); + nhp = hp; + + /* bitmap change matrix + * res | none leaf bitmap + * ---------------------------- + * n=1 | remove remove keep + * n=2 | other keep keep + * n>2 | shrink keep keep + * + * other: (remember, n is 2) + * shrink if the other bitmap value is a bitmap node + * remove if the other bitmap value is a leaf + * + * remove: + * this bitmap node is removed, res is moved up in tree (could be none) + * this is a special case of shrink + * + * keep: + * the current path index is still used down in the tree, need to keep it + * copy as usual with the updated res + * + * shrink: + * the current path index is no longer used down in the tree, remove it (shrink) + */ + if (res == THE_NON_VALUE) { + if (n == 1) { + break; + } else if (n == 2) { + if (slot == 0) { + ix = 2; /* off by one 'cause hdr */ + } else { + ix = 1; /* off by one 'cause hdr */ + } + if (primary_tag(ptr[ix]) == TAG_PRIMARY_LIST) { + res = ptr[ix]; + } else { + hval = MAP_HEADER_VAL(hdr); + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval ^ bp); + *hp++ = ptr[ix]; + res = make_hashmap(nhp); + } + } else { + /* n > 2 */ + hval = MAP_HEADER_VAL(hdr); + *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval ^ bp); ptr++; + n -= slot; + while(slot--) { *hp++ = *ptr++; } + ptr++; n--; + while(n--) { *hp++ = *ptr++; } + res = make_hashmap(nhp); + } + } else if (primary_tag(res) == TAG_PRIMARY_LIST && n == 1) { + break; + } else { + /* res is bitmap or leaf && n > 1, keep */ + n -= slot; + *hp++ = *ptr++; + while(slot--) { *hp++ = *ptr++; } + *hp++ = res; + ptr++; n--; + while(n--) { *hp++ = *ptr++; } + res = make_hashmap(nhp); + } + break; + case HAMT_SUBTAG_HEAD_BITMAP: + slot = (Uint) ESTACK_POP(stack); + bp = (Uint32) ESTACK_POP(stack); + n = (Uint32) ESTACK_POP(stack); + nhp = hp; + + if (res != THE_NON_VALUE) { + *hp++ = *ptr++; + *hp++ = (*ptr++) - 1; + n -= slot; + while(slot--) { *hp++ = *ptr++; } + *hp++ = res; + ptr++; n--; + while(n--) { *hp++ = *ptr++; } + } else { + hval = MAP_HEADER_VAL(hdr); + *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(hval ^ bp); ptr++; + *hp++ = (*ptr++) - 1; + n -= slot; + while(slot--) { *hp++ = *ptr++; } + ptr++; n--; + while(n--) { *hp++ = *ptr++; } + } + res = make_hashmap(nhp); + break; + default: + erl_exit(1, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); + break; + } + } while(!ESTACK_ISEMPTY(stack)); + HRelease(p, hp_end, hp); +not_found: + DESTROY_ESTACK(stack); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); + ERTS_HOLE_CHECK(p); + UnUseTmpHeapNoproc(2); + return res; } -int erts_validate_and_sort_map(map_t* mp) + +int erts_validate_and_sort_flatmap(flatmap_t* mp) { - Eterm *ks = map_get_keys(mp); - Eterm *vs = map_get_values(mp); - Uint sz = map_get_size(mp); + Eterm *ks = flatmap_get_keys(mp); + Eterm *vs = flatmap_get_values(mp); + Uint sz = flatmap_get_size(mp); Uint ix,jx; Eterm tmp; - int c; + Sint c; /* sort */ @@ -811,6 +2504,59 @@ int erts_validate_and_sort_map(map_t* mp) return 1; } +/* Really rough estimate of sqrt(x) + * Guaranteed not to be less than sqrt(x) + */ +static int int_sqrt_ceiling(Uint x) +{ + int n; + + if (x <= 2) + return x; + + n = erts_fit_in_bits_uint(x-1); + if (n & 1) { + /* Calc: sqrt(2^n) = 2^(n/2) * sqrt(2) ~= 2^(n/2) * 3 / 2 */ + return (1 << (n/2 - 1)) * 3; + } + else { + /* Calc: sqrt(2^n) = 2^(n/2) */ + return 1 << (n / 2); + } +} + +Uint hashmap_over_estimated_heap_size(Uint k) +{ + /* k is nr of key-value pairs. + N(k) is expected nr of nodes in hamt. + + Observation: + For uniformly distributed hash values, average of N varies between + 0.3*k and 0.4*k (with a beautiful sine curve) + and standard deviation of N is about sqrt(k)/3. + + Assuming normal probability distribution, we overestimate nr of nodes + by 15 std.devs above the average, which gives a probability for overrun + less than 1.0e-49 (same magnitude as a git SHA1 collision). + */ + Uint max_nodes = 2*k/5 + (15/3)*int_sqrt_ceiling(k); + return (k*2 + /* leaf cons cells */ + k + /* leaf list terms */ + max_nodes*2); /* headers + parent boxed terms */ +} + + +BIF_RETTYPE erts_debug_map_info_1(BIF_ALIST_1) { + if (is_hashmap(BIF_ARG_1)) { + BIF_RET(hashmap_info(BIF_P,BIF_ARG_1)); + } else if (is_flatmap(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } else { + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); + } +} + /* * erts_internal:map_to_tuple_keys/1 * @@ -818,9 +2564,225 @@ int erts_validate_and_sort_map(map_t* mp) */ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { - map_t *mp = (map_t*)map_val(BIF_ARG_1); + if (is_flatmap(BIF_ARG_1)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1); BIF_RET(mp->keys); + } else if (is_hashmap(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } else { + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); } - BIF_ERROR(BIF_P, BADARG); } + +/* + * erts_internal:map_type/1 + * + * Used in erts_debug:size/1 + */ + +BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) { + DECL_AM(hashmap); + DECL_AM(hashmap_node); + DECL_AM(flatmap); + if (is_map(BIF_ARG_1)) { + Eterm hdr = *(boxed_val(BIF_ARG_1)); + ASSERT(is_header(hdr)); + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_FLATMAP: + BIF_RET(AM_flatmap); + case HAMT_SUBTAG_HEAD_ARRAY: + case HAMT_SUBTAG_HEAD_BITMAP: + BIF_RET(AM_hashmap); + case HAMT_SUBTAG_NODE_BITMAP: + BIF_RET(AM_hashmap_node); + default: + erl_exit(1, "bad header"); + } + } + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); +} + +/* + * erts_internal:map_hashmap_children/1 + * + * Used in erts_debug:size/1 + */ + +BIF_RETTYPE erts_internal_map_hashmap_children_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + Eterm node = BIF_ARG_1; + Eterm *ptr, hdr, *hp, res = NIL; + Uint sz = 0; + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_FLATMAP: + BIF_ERROR(BIF_P, BADARG); + case HAMT_SUBTAG_HEAD_BITMAP: + ptr++; + case HAMT_SUBTAG_NODE_BITMAP: + ptr++; + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + break; + case HAMT_SUBTAG_HEAD_ARRAY: + sz = 16; + ptr += 2; + break; + default: + erl_exit(1, "bad header\r\n"); + break; + } + ASSERT(sz < 17); + hp = HAlloc(BIF_P, 2*sz); + while(sz--) { res = CONS(hp, *ptr++, res); hp += 2; } + BIF_RET(res); + } + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, BADMAP); +} + + +static Eterm hashmap_info(Process *p, Eterm node) { + Eterm *hp; + Eterm res = NIL, info = NIL; + Eterm *ptr, tup, hdr; + Uint sz; + DECL_AM(depth); + DECL_AM(leafs); + DECL_AM(bitmaps); + DECL_AM(arrays); + Uint nleaf=0, nbitmap=0, narray=0; + Uint bitmap_usage[16], leaf_usage[16]; + Uint lvl = 0, clvl; + DECLARE_ESTACK(stack); + + for (sz = 0; sz < 16; sz++) { + bitmap_usage[sz] = 0; + leaf_usage[sz] = 0; + } + + ptr = boxed_val(node); + ESTACK_PUSH(stack, 0); + ESTACK_PUSH(stack, node); + do { + node = ESTACK_POP(stack); + clvl = ESTACK_POP(stack); + if (lvl < clvl) + lvl = clvl; + switch(primary_tag(node)) { + case TAG_PRIMARY_LIST: + nleaf++; + leaf_usage[clvl] += 1; + break; + case TAG_PRIMARY_BOXED: + ptr = boxed_val(node); + hdr = *ptr; + ASSERT(is_header(hdr)); + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_NODE_BITMAP: + nbitmap++; + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(sz < 17); + bitmap_usage[sz-1] += 1; + while(sz--) { + ESTACK_PUSH(stack, clvl + 1); + ESTACK_PUSH(stack, ptr[sz+1]); + } + break; + case HAMT_SUBTAG_HEAD_BITMAP: + nbitmap++; + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + bitmap_usage[sz-1] += 1; + while(sz--) { + ESTACK_PUSH(stack, clvl + 1); + ESTACK_PUSH(stack, ptr[sz+2]); + } + break; + case HAMT_SUBTAG_HEAD_ARRAY: + narray++; + sz = 16; + while(sz--) { + ESTACK_PUSH(stack, clvl + 1); + ESTACK_PUSH(stack, ptr[sz+2]); + } + break; + default: + erl_exit(1, "bad header\r\n"); + break; + } + } + } while(!ESTACK_ISEMPTY(stack)); + + + /* size */ + sz = 0; + hashmap_bld_tuple_uint(NULL,&sz,16,leaf_usage); + hashmap_bld_tuple_uint(NULL,&sz,16,bitmap_usage); + + /* alloc */ + hp = HAlloc(p, 2+3 + 3*(2+4) + sz); + + info = hashmap_bld_tuple_uint(&hp,NULL,16,leaf_usage); + tup = TUPLE3(hp, AM_leafs, make_small(nleaf),info); hp += 4; + res = CONS(hp, tup, res); hp += 2; + + info = hashmap_bld_tuple_uint(&hp,NULL,16,bitmap_usage); + tup = TUPLE3(hp, AM_bitmaps, make_small(nbitmap), info); hp += 4; + res = CONS(hp, tup, res); hp += 2; + + tup = TUPLE3(hp, AM_arrays, make_small(narray),NIL); hp += 4; + res = CONS(hp, tup, res); hp += 2; + + tup = TUPLE2(hp, AM_depth, make_small(lvl)); hp += 3; + res = CONS(hp, tup, res); hp += 2; + + DESTROY_ESTACK(stack); + ERTS_HOLE_CHECK(p); + return res; +} + +static Eterm hashmap_bld_tuple_uint(Uint **hpp, Uint *szp, Uint n, Uint nums[]) { + Eterm res = THE_NON_VALUE; + Eterm *ts = (Eterm *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(Eterm)); + Uint i; + + for (i = 0; i < n; i++) { + ts[i] = erts_bld_uint(hpp, szp, nums[i]); + } + res = erts_bld_tuplev(hpp, szp, n, ts); + erts_free(ERTS_ALC_T_TMP, (void *) ts); + return res; +} + + +/* implementation of builtin emulations */ + +#if !ERTS_AT_LEAST_GCC_VSN__(3, 4, 0) +/* Count leading zeros emulation */ +Uint32 hashmap_clz(Uint32 x) { + Uint32 y; + int n = 32; + y = x >>16; if (y != 0) {n = n -16; x = y;} + y = x >> 8; if (y != 0) {n = n - 8; x = y;} + y = x >> 4; if (y != 0) {n = n - 4; x = y;} + y = x >> 2; if (y != 0) {n = n - 2; x = y;} + y = x >> 1; if (y != 0) return n - 2; + return n - x; +} + +const Uint32 SK5 = 0x55555555, SK3 = 0x33333333; +const Uint32 SKF0 = 0xF0F0F0F, SKFF = 0xFF00FF; + +/* CTPOP emulation */ +Uint32 hashmap_bitcount(Uint32 x) { + x -= ((x >> 1 ) & SK5); + x = (x & SK3 ) + ((x >> 2 ) & SK3 ); + x = (x & SKF0) + ((x >> 4 ) & SKF0); + x += x >> 8; + return (x + (x >> 16)) & 0x3F; +} +#endif diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index 2e02ca4677..2cc6768bfc 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -22,13 +22,23 @@ #define __ERL_MAP_H__ #include "sys.h" + +/* instrinsic wrappers */ +#if ERTS_AT_LEAST_GCC_VSN__(3, 4, 0) +#define hashmap_clz(x) ((Uint32) __builtin_clz((unsigned int)(x))) +#define hashmap_bitcount(x) ((Uint32) __builtin_popcount((unsigned int) (x))) +#else +Uint32 hashmap_clz(Uint32 x); +Uint32 hashmap_bitcount(Uint32 x); +#endif + /* MAP */ -typedef struct map_s { +typedef struct flatmap_s { Eterm thing_word; Uint size; Eterm keys; /* tuple */ -} map_t; +} flatmap_t; /* map node * * ----------- @@ -42,39 +52,144 @@ typedef struct map_s { * ----------- */ +/* the head-node is a bitmap or array with an untagged size */ + + +#define hashmap_size(x) (((hashmap_head_t*) hashmap_val(x))->size) +#define hashmap_size_rel(RTERM, BASE) hashmap_size(rterm2wterm(RTERM, BASE)) +#define hashmap_make_hash(Key) make_internal_hash(Key) + +#define hashmap_restore_hash(Heap,Lvl,Key) \ + (((Lvl) < 8) ? hashmap_make_hash(Key) >> (4*(Lvl)) : hashmap_make_hash(CONS(Heap, make_small((Lvl)>>3), (Key))) >> (4*((Lvl) & 7))) +#define hashmap_shift_hash(Heap,Hx,Lvl,Key) \ + (((++(Lvl)) & 7) ? (Hx) >> 4 : hashmap_make_hash(CONS(Heap, make_small((Lvl)>>3), Key))) /* erl_term.h stuff */ -#define make_map(x) make_boxed((Eterm*)(x)) -#define make_map_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE)) -#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val((x)))) -#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE)) -#define is_not_map(x) (!is_map((x))) -#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP) -#define header_is_map(x) ((((x) & (_HEADER_SUBTAG_MASK)) == MAP_SUBTAG)) -#define map_val(x) (_unchecked_boxed_val((x))) -#define map_val_rel(RTERM, BASE) map_val(rterm2wterm(RTERM, BASE)) - -#define map_get_values(x) (((Eterm *)(x)) + 3) -#define map_get_keys(x) (((Eterm *)tuple_val(((map_t *)(x))->keys)) + 1) -#define map_get_size(x) (((map_t*)(x))->size) - -#define MAP_HEADER _make_header(1,_TAG_HEADER_MAP) -#define MAP_HEADER_SIZE (sizeof(map_t) / sizeof(Eterm)) - -Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map); -int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res); -int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); -int erts_validate_and_sort_map(map_t* map); +#define flatmap_get_values(x) (((Eterm *)(x)) + 3) +#define flatmap_get_keys(x) (((Eterm *)tuple_val(((flatmap_t *)(x))->keys)) + 1) +#define flatmap_get_size(x) (((flatmap_t*)(x))->size) + +#ifdef DEBUG +#define MAP_SMALL_MAP_LIMIT (3) +#else +#define MAP_SMALL_MAP_LIMIT (32) +#endif + +struct ErtsWStack_; +struct ErtsEStack_; + +Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map); +int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res); +int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); + +Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, + Eterm node, int is_update); +int erts_hashmap_insert_down(Uint32 hx, Eterm key, Eterm node, Uint *sz, + Uint *upsz, struct ErtsEStack_ *sp, int is_update); +Eterm erts_hashmap_insert_up(Eterm *hp, Eterm key, Eterm value, + Uint *upsz, struct ErtsEStack_ *sp); + +int erts_validate_and_sort_flatmap(flatmap_t* map); +Uint hashmap_over_estimated_heap_size(Uint n); +void hashmap_iterator_init(struct ErtsWStack_* s, Eterm node, int reverse); +Eterm* hashmap_iterator_next(struct ErtsWStack_* s); +Eterm* hashmap_iterator_prev(struct ErtsWStack_* s); +int hashmap_key_hash_cmp(Eterm* ap, Eterm* bp); +Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int reject_dupkeys); + +#define erts_hashmap_from_ks_and_vs(P, KS, VS, N) \ + erts_hashmap_from_ks_and_vs_extra((P), (KS), (VS), (N), THE_NON_VALUE, THE_NON_VALUE); + +Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint n, + Eterm k, Eterm v); -#if HALFWORD_HEAP const Eterm * +#if HALFWORD_HEAP erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base); # define erts_maps_get(A, B) erts_maps_get_rel(A, B, NULL) #else -const Eterm * erts_maps_get(Eterm key, Eterm map); # define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B) #endif +const Eterm * +#if HALFWORD_HEAP +erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base); +# define erts_hashmap_get(Hx, K, M) erts_hashmap_get_rel(Hx, K, M, NULL) +#else +erts_hashmap_get(Uint32 hx, Eterm key, Eterm map); +# define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M) +#endif + +/* hamt nodes v2.0 + * + * node :: leaf | array | bitmap + * head + */ +typedef struct hashmap_head_s { + Eterm thing_word; + Uint size; + Eterm items[1]; +} hashmap_head_t; + +/* thing_word tagscheme + * Need two bits for map subtags + * + * Original HEADER representation: + * + * aaaaaaaaaaaaaaaa aaaaaaaaaatttt00 arity:26, tag:4 + * + * For maps we have: + * + * vvvvvvvvvvvvvvvv aaaaaaaamm111100 val:16, arity:8, mtype:2 + * + * unsure about trailing zeros + * + * map-tag: + * 00 - flat map tag (non-hamt) -> val:16 = #items + * 01 - map-node bitmap tag -> val:16 = bitmap + * 10 - map-head (array-node) -> val:16 = 0xffff + * 11 - map-head (bitmap-node) -> val:16 = bitmap + */ + +/* erl_map.h stuff */ + +#define is_hashmap_header_head(x) ((MAP_HEADER_TYPE(x) & (0x2))) + +#define MAKE_MAP_HEADER(Type,Arity,Val) \ + (_make_header(((((Uint16)(Val)) << MAP_HEADER_ARITY_SZ) | (Arity)) << MAP_HEADER_TAG_SZ | (Type) , _TAG_HEADER_MAP)) + +#define MAP_HEADER_FLATMAP \ + MAKE_MAP_HEADER(MAP_HEADER_TAG_FLATMAP_HEAD,0x1,0x0) + +#define MAP_HEADER_HAMT_HEAD_ARRAY \ + MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_ARRAY,0x1,0xffff) + +#define MAP_HEADER_HAMT_HEAD_BITMAP(Bmp) \ + MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_BITMAP,0x1,Bmp) + +#define MAP_HEADER_HAMT_NODE_BITMAP(Bmp) \ + MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_NODE_BITMAP,0x0,Bmp) + +#define MAP_HEADER_FLATMAP_SZ (sizeof(flatmap_t) / sizeof(Eterm)) + +#define HAMT_NODE_ARRAY_SZ (17) +#define HAMT_HEAD_ARRAY_SZ (18) +#define HAMT_NODE_BITMAP_SZ(n) (1 + n) +#define HAMT_HEAD_BITMAP_SZ(n) (2 + n) + +/* 2 bits maps tag + 4 bits subtag + 2 ignore bits */ +#define _HEADER_MAP_SUBTAG_MASK (0xfc) +/* 1 bit map tag + 1 ignore bit + 4 bits subtag + 2 ignore bits */ +#define _HEADER_MAP_HASHMAP_HEAD_MASK (0xbc) + +#define HAMT_SUBTAG_NODE_BITMAP ((MAP_HEADER_TAG_HAMT_NODE_BITMAP << _HEADER_ARITY_OFFS) | MAP_SUBTAG) +#define HAMT_SUBTAG_HEAD_ARRAY ((MAP_HEADER_TAG_HAMT_HEAD_ARRAY << _HEADER_ARITY_OFFS) | MAP_SUBTAG) +#define HAMT_SUBTAG_HEAD_BITMAP ((MAP_HEADER_TAG_HAMT_HEAD_BITMAP << _HEADER_ARITY_OFFS) | MAP_SUBTAG) +#define HAMT_SUBTAG_HEAD_FLATMAP ((MAP_HEADER_TAG_FLATMAP_HEAD << _HEADER_ARITY_OFFS) | MAP_SUBTAG) + +#define hashmap_index(hash) (((Uint32)hash) & 0xf) + + #endif diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 8870fac7d9..ccfc2e6458 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -369,11 +369,7 @@ erts_queue_dist_message(Process *rcvr, tok_label, tok_lastcnt, tok_serial); } #endif - erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token); } else { /* Enqueue message on external format */ @@ -563,15 +559,15 @@ queue_message(Process *c_p, } void -erts_queue_message(Process* receiver, - ErtsProcLocks *receiver_locks, - ErlHeapFragment* bp, - Eterm message, - Eterm seq_trace_token #ifdef USE_VM_PROBES - , Eterm dt_utag +erts_queue_message_probe(Process* receiver, ErtsProcLocks *receiver_locks, + ErlHeapFragment* bp, + Eterm message, Eterm seq_trace_token, Eterm dt_utag) +#else +erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, + ErlHeapFragment* bp, + Eterm message, Eterm seq_trace_token) #endif - ) { queue_message(NULL, receiver, @@ -1117,11 +1113,7 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, /* the trace token must in this case be updated by the caller */ seq_trace_output(token, save, SEQ_TRACE_SEND, to->common.id, NULL); temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap); - erts_queue_message(to, to_locksp, bp, save, temptoken -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(to, to_locksp, bp, save, temptoken); } else { ErlOffHeap *ohp; sz_reason = size_object(reason); @@ -1138,11 +1130,19 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, ? from : copy_struct(from, sz_from, &hp, ohp)); save = TUPLE3(hp, am_EXIT, from_copy, mess); - erts_queue_message(to, to_locksp, bp, save, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(to, to_locksp, bp, save, NIL); } } +Eterm* erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra) +{ + Eterm* res; + if (factory->p) { + res = HAllocX(factory->p, need, xtra); + } else { + res = factory->hp; + factory->hp += need; + } + return res; +} + diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 0f3bb8d281..1e1dafee90 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -68,6 +68,21 @@ struct erl_heap_fragment { Eterm mem[1]; /* Data */ }; +typedef struct { + Process* p; + Eterm* hp; +} ErtsHeapFactory; + +Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra); +#ifdef CHECK_FOR_HOLES +# define ERTS_FACTORY_HOLE_CHECK(f) do { \ + if ((f)->p) erts_check_for_holes((f)->p); \ + } while (0) +#else +# define ERTS_FACTORY_HOLE_CHECK(p) +#endif + + typedef struct erl_mesg { struct erl_mesg* next; /* Next message */ union { @@ -233,11 +248,17 @@ ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, Eterm *, Uint); void free_message_buffer(ErlHeapFragment *); void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm); -void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, Eterm, Eterm #ifdef USE_VM_PROBES - , Eterm dt_utag +void erts_queue_message_probe(Process*, ErtsProcLocks*, ErlHeapFragment*, + Eterm message, Eterm seq_trace_token, Eterm dt_utag); +#define erts_queue_message(RP,RL,BP,Msg,SEQ) \ + erts_queue_message_probe((RP),(RL),(BP),(Msg),(SEQ),NIL) +#else +void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, + Eterm message, Eterm seq_trace_token); +#define erts_queue_message_probe(RP,RL,BP,Msg,SEQ,TAG) \ + erts_queue_message((RP),(RL),(BP),(Msg),(SEQ)) #endif -); void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm); Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned); void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp); diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h index fb11dbbd22..9972890db7 100644 --- a/erts/emulator/beam/erl_monitors.h +++ b/erts/emulator/beam/erl_monitors.h @@ -82,6 +82,7 @@ /* Type tags for monitors */ #define MON_ORIGIN 1 #define MON_TARGET 3 +#define MON_TIME_OFFSET 7 /* Type tags for links */ #define LINK_PID 1 /* ...Or port */ @@ -103,7 +104,7 @@ typedef struct erts_monitor_or_link { typedef struct erts_monitor { struct erts_monitor *left, *right; Sint16 balance; - Uint16 type; /* MON_ORIGIN | MON_TARGET */ + Uint16 type; /* MON_ORIGIN | MON_TARGET | MON_TIME_OFFSET */ Eterm ref; Eterm pid; /* In case of distributed named monitor, this is the nodename atom in MON_ORIGIN process, otherwise a pid or diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 198acfd128..426a00304e 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -36,6 +36,7 @@ #include "erl_thr_progress.h" #include "dtrace-wrapper.h" #include "erl_process.h" +#include "erl_bif_unique.h" #if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) #define HAVE_USE_DTRACE 1 #endif @@ -127,6 +128,7 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif) env->heap_frag = NULL; env->fpe_was_unmasked = erts_block_fpe(); env->tmp_obj_list = NULL; + env->exception_thrown = 0; } static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif) @@ -334,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; @@ -356,17 +358,13 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, if (flush_me) { flush_env(env); /* Needed for ERTS_HOLE_CHECK */ } - erts_queue_message(rp, &rp_locks, frags, msg, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, frags, msg, am_undefined); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; 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); } @@ -739,9 +737,15 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, Eterm enif_make_badarg(ErlNifEnv* env) { + env->exception_thrown = 1; BIF_ERROR(env->proc, BADARG); } +int enif_has_pending_exception(ErlNifEnv* env) +{ + return env->exception_thrown; +} + int enif_get_atom(ErlNifEnv* env, Eterm atom, char* buf, unsigned len, ErlNifCharEncoding encoding) { @@ -961,8 +965,12 @@ ERL_NIF_TERM enif_make_uint64(ErlNifEnv* env, ErlNifUInt64 i) ERL_NIF_TERM enif_make_double(ErlNifEnv* env, double d) { - Eterm* hp = alloc_heap(env,FLOAT_SIZE_OBJECT); + Eterm* hp; FloatDef f; + + if (!erts_isfinite(d)) + return enif_make_badarg(env); + hp = alloc_heap(env,FLOAT_SIZE_OBJECT); f.fd = d; PUT_DOUBLE(f, hp); return make_float(hp); @@ -975,6 +983,8 @@ ERL_NIF_TERM enif_make_atom(ErlNifEnv* env, const char* name) ERL_NIF_TERM enif_make_atom_len(ErlNifEnv* env, const char* name, size_t len) { + if (len > MAX_ATOM_CHARACTERS) + return enif_make_badarg(env); return erts_atom_put((byte*)name, len, ERTS_ATOM_ENC_LATIN1, 1); } @@ -988,6 +998,8 @@ int enif_make_existing_atom_len(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding encoding) { ASSERT(encoding == ERL_NIF_LATIN1); + if (len > MAX_ATOM_CHARACTERS) + return 0; return erts_atom_get(name, len, atom, ERTS_ATOM_ENC_LATIN1); } @@ -1751,14 +1763,13 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(ep); if (ep->fp) fp = NULL; - if (is_non_value(result)) { + if (is_non_value(result) || env->exception_thrown) { if (proc->freason != TRAP) { - ASSERT(proc->freason == BADARG); return init_nif_sched_data(env, dirty_nif_exception, fp, 0, argc, argv); } else { if (ep->fp == NULL) restore_nif_mfa(proc, ep, 1); - return result; + return THE_NON_VALUE; } } else @@ -1910,29 +1921,33 @@ int enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term) int enif_get_map_size(ErlNifEnv* env, ERL_NIF_TERM term, size_t *size) { - if (is_map(term)) { - map_t *mp; - mp = (map_t*)map_val(term); - *size = map_get_size(mp); + if (is_flatmap(term)) { + flatmap_t *mp; + mp = (flatmap_t*)flatmap_val(term); + *size = flatmap_get_size(mp); return 1; } + else if (is_hashmap(term)) { + *size = hashmap_size(term); + return 1; + } return 0; } ERL_NIF_TERM enif_make_new_map(ErlNifEnv* env) { - Eterm* hp = alloc_heap(env,MAP_HEADER_SIZE+1); + Eterm* hp = alloc_heap(env,MAP_HEADER_FLATMAP_SZ+1); Eterm tup; - map_t *mp; + flatmap_t *mp; tup = make_tuple(hp); *hp++ = make_arityval(0); - mp = (map_t*)hp; - mp->thing_word = MAP_HEADER; + mp = (flatmap_t*)hp; + mp->thing_word = MAP_HEADER_FLATMAP; mp->size = 0; mp->keys = tup; - return make_map(mp); + return make_flatmap(mp); } int enif_make_map_put(ErlNifEnv* env, @@ -1941,7 +1956,7 @@ int enif_make_map_put(ErlNifEnv* env, Eterm value, Eterm *map_out) { - if (is_not_map(map_in)) { + if (!is_map(map_in)) { return 0; } flush_env(env); @@ -1956,7 +1971,7 @@ int enif_get_map_value(ErlNifEnv* env, Eterm *value) { const Eterm *ret; - if (is_not_map(map)) { + if (!is_map(map)) { return 0; } ret = erts_maps_get(key, map); @@ -1974,7 +1989,7 @@ int enif_make_map_update(ErlNifEnv* env, Eterm *map_out) { int res; - if (is_not_map(map_in)) { + if (!is_map(map_in)) { return 0; } @@ -1990,7 +2005,7 @@ int enif_make_map_remove(ErlNifEnv* env, Eterm *map_out) { int res; - if (is_not_map(map_in)) { + if (!is_map(map_in)) { return 0; } flush_env(env); @@ -2004,13 +2019,13 @@ int enif_map_iterator_create(ErlNifEnv *env, ErlNifMapIterator *iter, ErlNifMapIteratorEntry entry) { - if (is_map(map)) { - map_t *mp = (map_t*)map_val(map); + if (is_flatmap(map)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(map); size_t offset; switch (entry) { case ERL_NIF_MAP_ITERATOR_HEAD: offset = 0; break; - case ERL_NIF_MAP_ITERATOR_TAIL: offset = map_get_size(mp) - 1; break; + case ERL_NIF_MAP_ITERATOR_TAIL: offset = flatmap_get_size(mp) - 1; break; default: goto error; } @@ -2019,14 +2034,37 @@ int enif_map_iterator_create(ErlNifEnv *env, */ iter->map = map; - iter->ks = ((Eterm *)map_get_keys(mp)) + offset; - iter->vs = ((Eterm *)map_get_values(mp)) + offset; - iter->t_limit = map_get_size(mp) + 1; + iter->u.flat.ks = ((Eterm *)flatmap_get_keys(mp)) + offset; + iter->u.flat.vs = ((Eterm *)flatmap_get_values(mp)) + offset; + iter->size = flatmap_get_size(mp); iter->idx = offset + 1; return 1; } - + else if (is_hashmap(map)) { + iter->map = map; + iter->size = hashmap_size(map); + iter->u.hash.wstack = erts_alloc(ERTS_ALC_T_NIF, sizeof(ErtsDynamicWStack)); + WSTACK_INIT(iter->u.hash.wstack, ERTS_ALC_T_NIF); + + switch (entry) { + case ERL_NIF_MAP_ITERATOR_HEAD: + iter->idx = 1; + hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 0); + iter->u.hash.kv = hashmap_iterator_next(&iter->u.hash.wstack->ws); + break; + case ERL_NIF_MAP_ITERATOR_TAIL: + iter->idx = hashmap_size(map); + hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 1); + iter->u.hash.kv = hashmap_iterator_prev(&iter->u.hash.wstack->ws); + break; + default: + goto error; + } + ASSERT(!!iter->u.hash.kv == (iter->idx >= 1 && + iter->idx <= iter->size)); + return 1; + } error: #ifdef DEBUG iter->map = THE_NON_VALUE; @@ -2036,48 +2074,97 @@ error: void enif_map_iterator_destroy(ErlNifEnv *env, ErlNifMapIterator *iter) { - /* not used */ + if (is_hashmap(iter->map)) { + WSTACK_DESTROY(iter->u.hash.wstack->ws); + erts_free(ERTS_ALC_T_NIF, iter->u.hash.wstack); + } + else + ASSERT(is_flatmap(iter->map)); + #ifdef DEBUG iter->map = THE_NON_VALUE; #endif - } int enif_map_iterator_is_tail(ErlNifEnv *env, ErlNifMapIterator *iter) { - ASSERT(iter && is_map(iter->map)); - ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1)); - return (iter->t_limit == 1 || iter->idx == iter->t_limit); + ASSERT(iter); + if (is_flatmap(iter->map)) { + ASSERT(iter->idx >= 0); + ASSERT(iter->idx <= flatmap_get_size(flatmap_val(iter->map)) + 1); + return (iter->size == 0 || iter->idx > iter->size); + } + else { + ASSERT(is_hashmap(iter->map)); + return iter->idx > iter->size; + } } int enif_map_iterator_is_head(ErlNifEnv *env, ErlNifMapIterator *iter) { - ASSERT(iter && is_map(iter->map)); - ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1)); - return (iter->t_limit == 1 || iter->idx == 0); + ASSERT(iter); + if (is_flatmap(iter->map)) { + ASSERT(iter->idx >= 0); + ASSERT(iter->idx <= flatmap_get_size(flatmap_val(iter->map)) + 1); + return (iter->size == 0 || iter->idx == 0); + } + else { + ASSERT(is_hashmap(iter->map)); + return iter->idx == 0; + } } int enif_map_iterator_next(ErlNifEnv *env, ErlNifMapIterator *iter) { - ASSERT(iter && is_map(iter->map)); - if (iter->idx < iter->t_limit) { - iter->idx++; - iter->ks++; - iter->vs++; + ASSERT(iter); + if (is_flatmap(iter->map)) { + if (iter->idx <= iter->size) { + iter->idx++; + iter->u.flat.ks++; + iter->u.flat.vs++; + } + return (iter->idx <= iter->size); + } + else { + ASSERT(is_hashmap(iter->map)); + + if (iter->idx <= hashmap_size(iter->map)) { + if (iter->idx < 1) { + hashmap_iterator_init(&iter->u.hash.wstack->ws, iter->map, 0); + } + iter->u.hash.kv = hashmap_iterator_next(&iter->u.hash.wstack->ws); + iter->idx++; + ASSERT(!!iter->u.hash.kv == (iter->idx <= iter->size)); + } + return iter->idx <= iter->size; } - return (iter->idx != iter->t_limit); } int enif_map_iterator_prev(ErlNifEnv *env, ErlNifMapIterator *iter) { - ASSERT(iter && is_map(iter->map)); - if (iter->idx > 0) { - iter->idx--; - iter->ks--; - iter->vs--; + ASSERT(iter); + if (is_flatmap(iter->map)) { + if (iter->idx > 0) { + iter->idx--; + iter->u.flat.ks--; + iter->u.flat.vs--; + } + return iter->idx > 0; + } + else { + ASSERT(is_hashmap(iter->map)); + + if (iter->idx > 0) { + if (iter->idx > iter->size) { + hashmap_iterator_init(&iter->u.hash.wstack->ws, iter->map, 1); + } + iter->u.hash.kv = hashmap_iterator_prev(&iter->u.hash.wstack->ws); + iter->idx--; + ASSERT(!!iter->u.hash.kv == (iter->idx > 0)); + } + return iter->idx > 0; } - return (iter->idx > 0); } int enif_map_iterator_get_pair(ErlNifEnv *env, @@ -2085,15 +2172,25 @@ int enif_map_iterator_get_pair(ErlNifEnv *env, Eterm *key, Eterm *value) { - ASSERT(iter && is_map(iter->map)); - if (iter->idx > 0 && iter->idx < iter->t_limit) { - ASSERT(iter->ks >= map_get_keys(map_val(iter->map)) && - iter->ks < (map_get_keys(map_val(iter->map)) + map_get_size(map_val(iter->map)))); - ASSERT(iter->vs >= map_get_values(map_val(iter->map)) && - iter->vs < (map_get_values(map_val(iter->map)) + map_get_size(map_val(iter->map)))); - *key = *(iter->ks); - *value = *(iter->vs); - return 1; + ASSERT(iter); + if (is_flatmap(iter->map)) { + if (iter->idx > 0 && iter->idx <= iter->size) { + ASSERT(iter->u.flat.ks >= flatmap_get_keys(flatmap_val(iter->map)) && + iter->u.flat.ks < (flatmap_get_keys(flatmap_val(iter->map)) + flatmap_get_size(flatmap_val(iter->map)))); + ASSERT(iter->u.flat.vs >= flatmap_get_values(flatmap_val(iter->map)) && + iter->u.flat.vs < (flatmap_get_values(flatmap_val(iter->map)) + flatmap_get_size(flatmap_val(iter->map)))); + *key = *(iter->u.flat.ks); + *value = *(iter->u.flat.vs); + return 1; + } + } + else { + ASSERT(is_hashmap(iter->map)); + if (iter->idx > 0 && iter->idx <= iter->size) { + *key = CAR(iter->u.hash.kv); + *value = CDR(iter->u.hash.kv); + return 1; + } } return 0; } diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 849024453c..c4fdfd4187 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -46,9 +46,10 @@ ** remove enif_schedule_dirty_nif, enif_schedule_dirty_nif_finalizer, enif_dirty_nif_finalizer ** add ErlNifEntry options ** add ErlNifFunc flags +** 2.8: 18.0 add enif_has_pending_exception */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 7 +#define ERL_NIF_MINOR_VERSION 8 /* * The emulator will refuse to load a nif-lib with a major version @@ -201,10 +202,18 @@ typedef enum typedef struct /* All fields all internal and may change */ { ERL_NIF_TERM map; - ERL_NIF_UINT t_limit; + ERL_NIF_UINT size; ERL_NIF_UINT idx; - ERL_NIF_TERM *ks; - ERL_NIF_TERM *vs; + union { + struct { + ERL_NIF_TERM *ks; + ERL_NIF_TERM *vs; + }flat; + struct { + struct ErtsDynamicWStack_* wstack; + ERL_NIF_TERM* kv; + }hash; + }u; void* __spare__[2]; /* for future additions to be ABI compatible (same struct size) */ } ErlNifMapIterator; diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 630cefae93..bdcbb32c46 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -156,6 +156,7 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_next, (ErlNifEnv *env, ErlNifMapIte ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_prev, (ErlNifEnv *env, ErlNifMapIterator *iter)); ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); +ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -305,6 +306,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_map_iterator_prev ERL_NIF_API_FUNC_MACRO(enif_map_iterator_prev) # define enif_map_iterator_get_pair ERL_NIF_API_FUNC_MACRO(enif_map_iterator_get_pair) # define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif) +# define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 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_printf_term.c b/erts/emulator/beam/erl_printf_term.c index c982dc2080..e0dfbd31b8 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -247,6 +247,17 @@ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) #define PRT_PATCH_FUN_SIZE ((Eterm) 7) #define PRT_LAST_ARRAY_ELEMENT ((Eterm) 8) /* Note! Must be last... */ +#if 0 +static char *format_binary(Uint16 x, char *b) { + int z; + b[16] = '\0'; + for (z = 0; z < 16; z++) { + b[15-z] = ((x>>z) & 0x1) ? '1' : '0'; + } + return b; +} +#endif + static int print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, Eterm* obj_base) /* ignored if !HALFWORD_HEAP */ @@ -554,28 +565,74 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } break; case MAP_DEF: - { - Uint n; - Eterm *ks, *vs; - map_t *mp = (map_t *)map_val(wobj); - n = map_get_size(mp); - ks = map_get_keys(mp); - vs = map_get_values(mp); - - PRINT_CHAR(res, fn, arg, '#'); - PRINT_CHAR(res, fn, arg, '{'); - WSTACK_PUSH(s, PRT_CLOSE_TUPLE); - if (n > 0) { - n--; - WSTACK_PUSH5(s, vs[n], PRT_TERM, PRT_ASSOC, ks[n], PRT_TERM); - while (n--) { - WSTACK_PUSH6(s, PRT_COMMA, vs[n], PRT_TERM, PRT_ASSOC, - ks[n], PRT_TERM); - } - } - } - break; - default: + if (is_flatmap(wobj)) { + Uint n; + Eterm *ks, *vs; + flatmap_t *mp = (flatmap_t *)flatmap_val(wobj); + n = flatmap_get_size(mp); + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + PRINT_CHAR(res, fn, arg, '#'); + PRINT_CHAR(res, fn, arg, '{'); + WSTACK_PUSH(s, PRT_CLOSE_TUPLE); + if (n > 0) { + n--; + WSTACK_PUSH5(s, vs[n], PRT_TERM, PRT_ASSOC, ks[n], PRT_TERM); + while (n--) { + WSTACK_PUSH6(s, PRT_COMMA, vs[n], PRT_TERM, PRT_ASSOC, + ks[n], PRT_TERM); + } + } + } else { + Uint n, mapval; + Eterm *head; + head = hashmap_val(wobj); + mapval = MAP_HEADER_VAL(*head); + switch (MAP_HEADER_TYPE(*head)) { + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY: + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP: + PRINT_STRING(res, fn, arg, "#<"); + PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval); + PRINT_STRING(res, fn, arg, ">{"); + WSTACK_PUSH(s,PRT_CLOSE_TUPLE); + n = hashmap_bitcount(mapval); + ASSERT(n < 17); + head += 2; + if (n > 0) { + n--; + WSTACK_PUSH(s, head[n]); + WSTACK_PUSH(s, PRT_TERM); + while (n--) { + WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH(s, head[n]); + WSTACK_PUSH(s, PRT_TERM); + } + } + break; + case MAP_HEADER_TAG_HAMT_NODE_BITMAP: + n = hashmap_bitcount(mapval); + head++; + PRINT_CHAR(res, fn, arg, '<'); + PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval); + PRINT_STRING(res, fn, arg, ">{"); + WSTACK_PUSH(s,PRT_CLOSE_TUPLE); + ASSERT(n < 17); + if (n > 0) { + n--; + WSTACK_PUSH(s, head[n]); + WSTACK_PUSH(s, PRT_TERM); + while (n--) { + WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH(s, head[n]); + WSTACK_PUSH(s, PRT_TERM); + } + } + break; + } + } + break; + default: PRINT_STRING(res, fn, arg, "<unknown:"); PRINT_POINTER(res, fn, arg, wobj); PRINT_CHAR(res, fn, arg, '>'); @@ -584,11 +641,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } L_done: - DESTROY_WSTACK(s); return res; } + int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision, ErlPfEterm* term_base) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ba09ee57c2..af8db519d4 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -43,8 +43,11 @@ #include "erl_async.h" #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) @@ -462,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, @@ -492,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 @@ -609,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 @@ -631,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; @@ -701,8 +706,8 @@ init_sched_wall_time(ErtsSchedWallTime *swtp) static ERTS_INLINE Uint64 sched_wall_time_ts(void) { -#ifdef HAVE_GETHRTIME - return (Uint64) sys_gethrtime(); +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + return (Uint64) erts_os_monotonic_time(); #else Uint64 res; SysTimeval tv; @@ -1022,11 +1027,7 @@ reply_sched_wall_time(void *vswtrp) hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, msg, NIL); if (swtrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -1034,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); @@ -1066,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) @@ -1127,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; @@ -1143,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); @@ -1771,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 @@ -1868,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); } } @@ -1917,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, @@ -2032,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; } @@ -2092,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 @@ -2141,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; @@ -2152,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) { @@ -2184,18 +2301,12 @@ void aux_work_timeout_late_init(void) { aux_work_tmo->initialized = 1; - if (erts_atomic32_read_nob(&aux_work_tmo->refc)) { - aux_work_tmo->timer.data.active = 0; - 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; @@ -2218,32 +2329,18 @@ aux_work_timeout(void *unused) if (refc != 1 || 1 != erts_atomic32_cmpxchg_relb(&aux_work_tmo->refc, 0, 1)) { /* Setup next timeout... */ - aux_work_tmo->timer.data.active = 0; - 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 - { - aux_work_tmo->timer.data.active = 0; - erts_set_timer(&aux_work_tmo->timer.data, - aux_work_timeout, - NULL, - NULL, - 1000); - } + start_aux_work_timer(esdp); } erts_aint32_t @@ -2274,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; @@ -2638,6 +2735,13 @@ thr_prgr_fin_wait(void *vssi) static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp); +void +erts_interupt_aux_thread_timed(ErtsMonotonicTime timeout_time) +{ + /* TODO only poke when needed (based on timeout_time) */ + erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(-1)); +} + static void * aux_thread(void *unused) { @@ -2768,6 +2872,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, thr_prgr_active); while (1) { + ErtsMonotonicTime current_time; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { @@ -2781,34 +2886,64 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_leader_update(esdp); } - if (aux_work) + if (aux_work) { flgs = erts_smp_atomic32_read_acqb(&ssi->flags); + 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); + sched_wall_time_change(esdp, 1); + } + erts_bump_timers(esdp->timer_wheel, current_time); + } + } else { - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 0); - sched_wall_time_change(esdp, 0); + ErtsMonotonicTime timeout_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); + sched_wall_time_change(esdp, 1); } - erts_thr_progress_prepare_wait(esdp); } + else { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 0); + sched_wall_time_change(esdp, 0); + } + erts_thr_progress_prepare_wait(esdp); + } - ERTS_SCHED_FAIR_YIELD(); + ERTS_SCHED_FAIR_YIELD(); - flgs = sched_spin_wait(ssi, spincount); - if (flgs & ERTS_SSI_FLG_SLEEPING) { - ASSERT(flgs & ERTS_SSI_FLG_WAITING); - flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); + flgs = sched_spin_wait(ssi, spincount); if (flgs & ERTS_SSI_FLG_SLEEPING) { - int res; - ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - do { - res = erts_tse_wait(ssi->event); - } while (res == EINTR); + 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(esdp); + 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(esdp); + } while (res == EINTR); + } } + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + erts_thr_progress_finalize_wait(esdp); } - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) - erts_thr_progress_finalize_wait(esdp); + if (current_time >= timeout_time) + erts_bump_timers(esdp->timer_wheel, current_time); } if (!(flgs & ERTS_SSI_FLG_WAITING)) { @@ -2841,7 +2976,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) else #endif { - erts_aint_t dt; erts_smp_atomic32_set_relb(&function_calls, 0); *fcalls = 0; @@ -2866,6 +3000,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) goto sys_aux_work; while (spincount-- > 0) { + ErtsMonotonicTime current_time; sys_poll_aux_work: @@ -2875,8 +3010,9 @@ 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 */ - dt = erts_do_time_read_and_reset(); - if (dt) erts_bump_timer(dt); + 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); sys_aux_work: #ifndef ERTS_SMP @@ -2991,8 +3127,11 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erl_sys_schedule(0); - dt = erts_do_time_read_and_reset(); - if (dt) erts_bump_timer(dt); + { + 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); + } #ifndef ERTS_SMP if (rq->len == 0 && !rq->misc.start) @@ -4883,9 +5022,11 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags) + ERTS_WAKEUP_OTHER_FIXED_INC); if (rq->wakeup_other > wakeup_other.limit) { #ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && rq->waiting) - wake_dirty_schedulers(rq, 1); - else + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { + if (rq->waiting) { + wake_dirty_schedulers(rq, 1); + } + } else #endif { int empty_rqs = @@ -5198,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; @@ -5262,6 +5404,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, #else esdp->no = (Uint) num; #endif + esdp->ssi = ssi; esdp->current_process = NULL; esdp->current_port = NULL; @@ -5274,6 +5417,12 @@ 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); + if (daww_ptr) { init_aux_work_data(&esdp->aux_work_data, esdp, *daww_ptr); #ifdef ERTS_SMP @@ -5872,6 +6021,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces free_proxy_proc(proxy); erts_smp_runq_lock(c_rq); + return 0; #ifdef ERTS_DIRTY_SCHEDULERS @@ -6584,7 +6734,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) int res; do { - res = erts_tse_wait(ssi->event); + res = erts_tse_twait(ssi->event, -1); } while (res == EINTR); } } @@ -6640,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); @@ -6747,6 +6898,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) erts_smp_mtx_unlock(&schdlr_sspnd.mtx); while (1) { + ErtsMonotonicTime current_time; erts_aint32_t qmask; erts_aint32_t flgs; @@ -6771,30 +6923,63 @@ suspend_scheduler(ErtsSchedulerData *esdp) } } - if (!aux_work) { - if (thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 0); - sched_wall_time_change(esdp, 0); + if (aux_work) { + 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); + sched_wall_time_change(esdp, 1); + } + erts_bump_timers(esdp->timer_wheel, current_time); } - erts_thr_progress_prepare_wait(esdp); - flgs = sched_spin_suspended(ssi, - ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); - if (flgs == (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_WAITING - | ERTS_SSI_FLG_SUSPENDED)) { - flgs = sched_set_suspended_sleeptype(ssi); + } + else { + ErtsMonotonicTime timeout_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) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } + } + else { + if (thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 0); + sched_wall_time_change(esdp, 0); + } + erts_thr_progress_prepare_wait(esdp); + flgs = sched_spin_suspended(ssi, + ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); if (flgs == (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_TSE_SLEEPING | ERTS_SSI_FLG_WAITING | ERTS_SSI_FLG_SUSPENDED)) { - int res; - - do { - res = erts_tse_wait(ssi->event); - } while (res == EINTR); + flgs = sched_set_suspended_sleeptype(ssi); + if (flgs == (ERTS_SSI_FLG_SLEEPING + | ERTS_SSI_FLG_TSE_SLEEPING + | ERTS_SSI_FLG_WAITING + | ERTS_SSI_FLG_SUSPENDED)) { + int res; + + current_time = erts_get_monotonic_time(esdp); + 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(esdp); + } while (res == EINTR); + } } + erts_thr_progress_finalize_wait(esdp); } - erts_thr_progress_finalize_wait(esdp); + + if (current_time >= timeout_time) + erts_bump_timers(esdp->timer_wheel, current_time); } flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING @@ -7613,6 +7798,9 @@ sched_thread_func(void *vesdp) ErtsThrPrgrCallbacks callbacks; ErtsSchedulerData *esdp = vesdp; Uint no = esdp->no; + + 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; @@ -7715,6 +7903,8 @@ sched_dirty_cpu_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + esdp->thr_id += erts_no_schedulers; + erts_thr_progress_register_unmanaged_thread(&callbacks); #ifdef ERTS_ENABLE_LOCK_CHECK { @@ -7776,6 +7966,8 @@ sched_dirty_io_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + esdp->thr_id += erts_no_schedulers + erts_no_dirty_cpu_schedulers; + erts_thr_progress_register_unmanaged_thread(&callbacks); #ifdef ERTS_ENABLE_LOCK_CHECK { @@ -8878,7 +9070,6 @@ Process *schedule(Process *p, int calls) { Process *proxy_p = NULL; ErtsRunQueue *rq; - erts_aint_t dt; ErtsSchedulerData *esdp; int context_reds; int fcalls; @@ -8978,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); @@ -8995,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 @@ -9008,10 +9196,12 @@ Process *schedule(Process *p, int calls) ERTS_SMP_CHK_NO_PROC_LOCKS; - dt = erts_do_time_read_and_reset(); - if (dt) { + 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_timer(dt); + erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time); erts_smp_runq_lock(rq); } BM_STOP_TIMER(system); @@ -9158,6 +9348,7 @@ Process *schedule(Process *p, int calls) else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && (fcalls > input_reductions && prepare_for_sys_schedule(esdp, !0))) { + ErtsMonotonicTime current_time; /* * Schedule system-level activities. */ @@ -9170,8 +9361,10 @@ Process *schedule(Process *p, int calls) #endif erts_smp_runq_unlock(rq); erl_sys_schedule(1); - dt = erts_do_time_read_and_reset(); - if (dt) erts_bump_timer(dt); + + 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); #ifdef ERTS_SMP erts_smp_runq_lock(rq); @@ -9310,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; @@ -9459,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; } } @@ -9511,15 +9713,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) ASSERT(hp_start + hsz == hp); #endif - erts_queue_message(rp, - &rp_locks, - bp, - msg, - NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, msg, NIL); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -10375,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); } @@ -10427,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(); @@ -10476,6 +10674,7 @@ 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); + /* Unsupported feature... */ state |= ERTS_PSFLG_BOUND; } prio = (erts_aint32_t) so->priority; @@ -10508,6 +10707,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->flags = erts_default_process_flags; + p->static_flags = 0; + if (so->flags & SPO_SYSTEM_PROC) + p->static_flags |= ERTS_STC_FLG_SYSTEM_PROC; if (so->flags & SPO_USE_ARGS) { p->min_heap_size = so->min_heap_size; p->min_vheap_size = so->min_vheap_size; @@ -10520,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. @@ -10563,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; @@ -10586,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 - sys_memset(&p->common.u.alive.tm, 0, sizeof(ErlTimer)); -#endif + ERTS_PTMR_INIT(p); p->common.u.alive.reg = NULL; ERTS_P_LINKS(p) = NULL; @@ -10621,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; @@ -10779,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 - memset(&(p->common.u.alive.tm), 0, sizeof(ErlTimer)); -#endif + ERTS_PTMR_INIT(p); p->next = NULL; p->off_heap.first = NULL; p->off_heap.overhead = 0; @@ -10804,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; @@ -10832,6 +11028,8 @@ void erts_init_empty_process(Process *p) p->parent = NIL; p->approx_started = 0; + p->static_flags = 0; + p->common.u.alive.started_interval = 0; #ifdef HIPE @@ -10896,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); @@ -11060,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) @@ -11205,11 +11403,7 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp); mess = copy_struct(exit_term, term_size, &hp, ohp); - erts_queue_message(to, to_locksp, bp, mess, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(to, to_locksp, bp, mess, NIL); } else { ErlHeapFragment* bp; Eterm* hp; @@ -11225,11 +11419,7 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, /* the trace token must in this case be updated by the caller */ seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL); temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap); - erts_queue_message(to, to_locksp, bp, mess, temp_token -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(to, to_locksp, bp, mess, temp_token); } } @@ -11482,7 +11672,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) ErtsMonitor *rmon; Process *rp; - if (mon->type == MON_ORIGIN) { + switch (mon->type) { + case MON_ORIGIN: /* We are monitoring someone else, we need to demonitor that one.. */ if (is_atom(mon->pid)) { /* remote by name */ ASSERT(is_node_name_atom(mon->pid)); @@ -11545,7 +11736,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) } } } - } else { /* type == MON_TARGET */ + break; + case MON_TARGET: ASSERT(mon->type == MON_TARGET); ASSERT(is_pid(mon->pid) || is_internal_port(mon->pid)); if (is_internal_port(mon->pid)) { @@ -11604,6 +11796,12 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) } } } + break; + case MON_TIME_OFFSET: + erts_demonitor_time_offset(mon->ref); + break; + default: + ERTS_INTERNAL_ERROR("Invalid monitor type"); } done: /* As the monitors are previously removed from the process, @@ -11750,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)) { @@ -11762,6 +11961,9 @@ erts_do_exit_process(Process* p, Eterm reason) } #endif + if (p->static_flags & ERTS_STC_FLG_SYSTEM_PROC) + erl_exit(1, "System process %T terminated: %T\n", p->common.id, reason); + #ifdef ERTS_SMP ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* By locking all locks (main lock is already locked) when going @@ -11801,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); } @@ -11839,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; @@ -11932,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! */ @@ -11950,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) @@ -12063,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. */ @@ -12278,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 d12ac792af..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; @@ -348,7 +350,7 @@ typedef struct { } ErtsRunQueueInfo; -#ifdef HAVE_GETHRTIME +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT # undef ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT # define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT 1 #endif @@ -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; @@ -564,6 +571,9 @@ struct ErtsSchedulerData_ { Eterm* x_reg_array; /* X registers */ FloatDef* f_reg_array; /* Floating point registers. */ + 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 */ @@ -590,6 +600,13 @@ 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; + ErtsSchedAllocData alloc_data; Uint64 reductions; @@ -907,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 */ @@ -921,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; @@ -936,6 +954,8 @@ struct process { Eterm parent; /* Pid of process that created this process. */ erts_approx_time_t approx_started; /* Time when started. */ + Uint32 static_flags; /* Flags that do *not* change */ + /* This is the place, where all fields that differs between memory * architectures, have gone to. */ @@ -1098,6 +1118,11 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) +/* + * Static flags that do not change after process creation. + */ +#define ERTS_STC_FLG_SYSTEM_PROC (((Uint32) 1) << 0) + /* The sequential tracing token is a tuple of size 5: * * {Flags, Label, Serial, Sender} @@ -1125,6 +1150,7 @@ void erts_check_for_holes(Process* p); #define SPO_LINK 1 #define SPO_USE_ARGS 2 #define SPO_MONITOR 4 +#define SPO_SYSTEM_PROC 8 /* * The following struct contains options for a process to be spawned. @@ -1247,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 \ @@ -1282,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) @@ -1574,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 @@ -1608,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 */ @@ -2228,6 +2255,8 @@ extern int erts_disable_proc_not_running_opt; void erts_smp_notify_inc_runq(ErtsRunQueue *runq); +void erts_interupt_aux_thread_timed(ErtsMonotonicTime timeout_time); + #ifdef ERTS_SMP void erts_sched_finish_poke(ErtsSchedulerSleepInfo *, erts_aint32_t); ERTS_GLB_INLINE void erts_sched_poke(ErtsSchedulerSleepInfo *ssi); diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 3ce707efda..00761f2d0e 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -47,7 +47,7 @@ /* Hash constant macros */ #define MAX_HASH 1342177280UL -#define INITIAL_SIZE 10 +#define INITIAL_SIZE (erts_pd_initial_size) /* Hash utility macros */ #define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition) 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_term.c b/erts/emulator/beam/erl_term.c index 28cbe7004f..bc04d7b78e 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -86,11 +86,12 @@ unsigned tag_val_def(Wterm x) case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF; case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; - case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF; } + break; } case TAG_PRIMARY_IMMED1: { diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 37014ccf94..602aab46dc 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -147,21 +147,21 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #define MAP_SUBTAG (0xF << _TAG_PRIMARY_SIZE) /* MAP */ -#define _TAG_HEADER_ARITYVAL (TAG_PRIMARY_HEADER|ARITYVAL_SUBTAG) -#define _TAG_HEADER_FUN (TAG_PRIMARY_HEADER|FUN_SUBTAG) -#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG) -#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG) -#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG) -#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG) -#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG) -#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG) -#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG) -#define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG) -#define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG) -#define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG) -#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG) +#define _TAG_HEADER_ARITYVAL (TAG_PRIMARY_HEADER|ARITYVAL_SUBTAG) +#define _TAG_HEADER_FUN (TAG_PRIMARY_HEADER|FUN_SUBTAG) +#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG) +#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG) +#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG) +#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG) +#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG) +#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG) +#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG) +#define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG) +#define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG) +#define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG) +#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG) #define _TAG_HEADER_BIN_MATCHSTATE (TAG_PRIMARY_HEADER|BIN_MATCHSTATE_SUBTAG) -#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG) +#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG) #define _TAG_HEADER_MASK 0x3F @@ -296,9 +296,10 @@ _ET_DECLARE_CHECKED(Uint,atom_val,Eterm) #define atom_val(x) _ET_APPLY(atom_val,(x)) /* header (arityval or thing) access methods */ -#define _make_header(sz,tag) ((Uint)(((sz) << _HEADER_ARITY_OFFS) + (tag))) +#define _make_header(sz,tag) ((Uint)(((Uint)(sz) << _HEADER_ARITY_OFFS) + (tag))) #define is_header(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_HEADER) -#define _unchecked_header_arity(x) ((x) >> _HEADER_ARITY_OFFS) +#define _unchecked_header_arity(x) \ + (is_map_header(x) ? MAP_HEADER_ARITY(x) : ((x) >> _HEADER_ARITY_OFFS)) _ET_DECLARE_CHECKED(Uint,header_arity,Eterm) #define header_arity(x) _ET_APPLY(header_arity,(x)) @@ -361,6 +362,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) ((((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_REFC_BIN) || \ (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_HEAP_BIN) || \ (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_SUB_BIN)) + #define make_binary(x) make_boxed((Eterm*)(x)) #define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x)))) #define is_not_binary(x) (!is_binary((x))) @@ -990,6 +992,44 @@ _ET_DECLARE_CHECKED(Uint32*,external_ref_data,Wterm) _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #define external_ref_node(x) _ET_APPLY(external_ref_node,(x)) +/* maps */ + +#define MAP_HEADER_TAG_SZ (2) +#define MAP_HEADER_ARITY_SZ (8) +#define MAP_HEADER_VAL_SZ (16) + +#define MAP_HEADER_TAG_FLATMAP_HEAD (0x0) +#define MAP_HEADER_TAG_HAMT_NODE_BITMAP (0x1) +#define MAP_HEADER_TAG_HAMT_HEAD_ARRAY (0x2) +#define MAP_HEADER_TAG_HAMT_HEAD_BITMAP (0x3) + +#define MAP_HEADER_TYPE(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS)) & (0x3)) +#define MAP_HEADER_ARITY(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ)) & (0xff)) +#define MAP_HEADER_VAL(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ + MAP_HEADER_ARITY_SZ)) & (0xffff)) + +#define make_hashmap(x) make_boxed((Eterm*)(x)) +#define make_hashmap_rel make_boxed_rel +#define is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x)))) +#define is_not_hashmap(x) (!is_hashmap(x)) +#define is_hashmap_rel(RTERM,BASE) is_hashmap(rterm2wterm(RTERM,BASE)) +#define is_hashmap_header(x) (((x) & (_HEADER_MAP_HASHMAP_HEAD_MASK)) == HAMT_SUBTAG_HEAD_ARRAY) +#define hashmap_val(x) _unchecked_boxed_val((x)) +#define hashmap_val_rel(RTERM, BASE) hashmap_val(rterm2wterm(RTERM, BASE)) + +#define make_flatmap(x) make_boxed((Eterm*)(x)) +#define make_flatmap_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE)) +#define is_flatmap(x) (is_boxed((x)) && is_flatmap_header(*boxed_val((x)))) +#define is_flatmap_rel(RTERM,BASE) is_flatmap(rterm2wterm(RTERM,BASE)) +#define is_not_flatmap(x) (!is_flatmap((x))) +#define is_flatmap_header(x) (((x) & (_HEADER_MAP_SUBTAG_MASK)) == HAMT_SUBTAG_HEAD_FLATMAP) +#define flatmap_val(x) (_unchecked_boxed_val((x))) +#define flatmap_val_rel(RTERM, BASE) flatmap_val(rterm2wterm(RTERM, BASE)) + +#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP) +#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val(x))) +#define is_not_map(x) (!is_map(x)) +#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE)) + /* number tests */ #define is_integer(x) (is_small(x) || is_big(x)) @@ -1096,6 +1136,8 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define BIG_DEF 0xf #define SMALL_DEF 0x10 +#define FIRST_VACANT_TAG_DEF 0x11 + #if ET_DEBUG extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); #define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__) diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index c2365c5cf7..78e0964e8b 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -1359,18 +1359,17 @@ void erts_thr_progress_fatal_error_wait(SWord timeout) { erts_aint32_t bc; SWord time_left = timeout; - SysTimeval to; + ErtsMonotonicTime timeout_time; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); /* * Counting poll intervals may give us a too long timeout - * if cpu is busy. If we got tolerant time of day we use it - * to prevent this. + * if cpu is busy. We use timeout time to try to prevent + * this. In case we havn't got time correction this may + * however fail too... */ - if (!erts_disable_tolerant_timeofday) { - erts_get_timeval(&to); - to.tv_sec += timeout / 1000; - to.tv_sec += timeout % 1000; - } + timeout_time = erts_get_monotonic_time(esdp); + timeout_time += ERTS_MSEC_TO_MONOTONIC((ErtsMonotonicTime) timeout); while (1) { if (erts_milli_sleep(ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL) == 0) @@ -1380,14 +1379,8 @@ erts_thr_progress_fatal_error_wait(SWord timeout) { break; /* Succefully blocked all managed threads */ if (time_left <= 0) break; /* Timeout */ - if (!erts_disable_tolerant_timeofday) { - SysTimeval now; - erts_get_timeval(&now); - if (now.tv_sec > to.tv_sec) - break; /* Timeout */ - if (now.tv_sec == to.tv_sec && now.tv_usec >= to.tv_usec) - break; /* Timeout */ - } + if (timeout_time <= erts_get_monotonic_time(esdp)) + break; /* Timeout */ } } diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 1fd800d524..dc20ac207f 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -652,6 +652,8 @@ ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep); ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep); ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep); ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount); +ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo); +ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo); ERTS_GLB_INLINE int erts_tse_is_tmp(erts_tse_t *ep); ERTS_GLB_INLINE void erts_thr_set_main_status(int, int); ERTS_GLB_INLINE int erts_thr_get_main_status(void); @@ -3490,6 +3492,27 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) #endif } +ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) +{ +#ifdef USE_THREADS + return ethr_event_twait(&((ethr_ts_event *) ep)->event, + (ethr_sint64_t) tmo); +#else + return ENOTSUP; +#endif +} + +ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo) +{ +#ifdef USE_THREADS + return ethr_event_stwait(&((ethr_ts_event *) ep)->event, + spincount, + (ethr_sint64_t) tmo); +#else + return ENOTSUP; +#endif +} + ERTS_GLB_INLINE int erts_tse_is_tmp(erts_tse_t *ep) { #ifdef USE_THREADS diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 7ed1a395ad..4560cd23af 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -20,91 +20,46 @@ #ifndef ERL_TIME_H__ #define ERL_TIME_H__ -#define ERTS_SHORT_TIME_T_MAX ERTS_AINT32_T_MAX -#define ERTS_SHORT_TIME_T_MIN ERTS_AINT32_T_MIN -typedef erts_aint32_t erts_short_time_t; +/* 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 -extern erts_smp_atomic32_t do_time; /* set at clock interrupt */ -extern SysTimeval erts_first_emu_time; +#if defined(DEBUG) || 0 +#define ERTS_TIME_ASSERT(B) ERTS_ASSERT(B) +#else +#define ERTS_TIME_ASSERT(B) ((void) 1) +#endif -/* -** 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 */ - Uint count; /* number of loops remaining */ - int active; /* 1=activated, 0=deactivated */ - /* called when timeout */ - void (*timeout)(void*); - /* called when cancel (may be NULL) */ - void (*cancel)(void*); - void* arg; /* argument to timeout/cancel procs */ -} ErlTimer; +typedef enum { + ERTS_NO_TIME_WARP_MODE, + ERTS_SINGLE_TIME_WARP_MODE, + ERTS_MULTI_TIME_WARP_MODE +} ErtsTimeWarpMode; -typedef void (*ErlTimeoutProc)(void*); -typedef void (*ErlCancelProc)(void*); +typedef struct ErtsTimerWheel_ ErtsTimerWheel; +typedef ErtsMonotonicTime * ErtsNextTimeoutRef; -#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; -}; +extern SysTimeval erts_first_emu_time; -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); -/* timer-wheel api */ +int erts_init_time_sup(int, ErtsTimeWarpMode); +void erts_late_init_time_sup(void); -void erts_init_time(void); -void erts_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); -void erts_cancel_timer(ErlTimer*); -void erts_bump_timer(erts_short_time_t); +ErtsNextTimeoutRef erts_get_next_timeout_reference(ErtsTimerWheel *); +void erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode); +void erts_bump_timers(ErtsTimerWheel *, ErtsMonotonicTime); Uint erts_timer_wheel_memory_size(void); -Uint erts_time_left(ErlTimer *); -erts_short_time_t erts_next_time(void); #ifdef DEBUG void erts_p_slpq(void); #endif -ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void); -ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void) -{ - erts_short_time_t time = erts_smp_atomic32_xchg_acqb(&do_time, 0); - if (time < 0) - erl_exit(ERTS_ABORT_EXIT, "Internal time management error\n"); - return time; -} - -ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t elapsed) -{ - erts_smp_atomic32_add_relb(&do_time, elapsed); -} - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - - /* time_sup */ #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) @@ -121,25 +76,381 @@ void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec); typedef UWord erts_approx_time_t; erts_approx_time_t erts_get_approx_time(void); -void erts_get_timeval(SysTimeval *tv); -erts_time_t erts_get_time(void); +int erts_has_time_correction(void); +int erts_check_time_adj_support(int time_correction, + ErtsTimeWarpMode time_warp_mode); + +ErtsTimeWarpMode erts_time_warp_mode(void); + +typedef enum { + ERTS_TIME_OFFSET_PRELIMINARY, + ERTS_TIME_OFFSET_FINAL, + ERTS_TIME_OFFSET_VOLATILE +} ErtsTimeOffsetState; -ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p); +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); + +#ifdef SYS_CLOCK_RESOLUTION +#define ERTS_CLKTCK_RESOLUTION ((ErtsMonotonicTime) (SYS_CLOCK_RESOLUTION*1000)) +#else +#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 +}; + +typedef struct { + union { + struct erts_time_sup_read_only__ o; + char align__[(((sizeof(struct erts_time_sup_read_only__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } r; +} ErtsTimeSupData; + +extern ErtsTimeSupData erts_time_sup__; + +ERTS_GLB_INLINE Uint64 +erts_time_unit_conversion(Uint64 value, + Uint32 from_time_unit, + Uint32 to_time_unit); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE int -erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p) +ERTS_GLB_INLINE Uint64 +erts_time_unit_conversion(Uint64 value, + Uint32 from_time_unit, + Uint32 to_time_unit) { - if (t1p->tv_sec == t2p->tv_sec) { - if (t1p->tv_usec < t2p->tv_usec) - return -1; - else if (t1p->tv_usec > t2p->tv_usec) - return 1; - return 0; - } - return t1p->tv_sec < t2p->tv_sec ? -1 : 1; + Uint64 high, low, result; + if (value <= ~((Uint64) 0)/to_time_unit) + return (value*to_time_unit)/from_time_unit; + + low = value & ((Uint64) 0xffffffff); + high = (value >> 32) & ((Uint64) 0xffffffff); + + low *= to_time_unit; + high *= to_time_unit; + + high += (low >> 32) & ((Uint64) 0xffffffff); + low &= ((Uint64) 0xffffffff); + + result = high % from_time_unit; + high /= from_time_unit; + high <<= 32; + + result <<= 32; + result += low; + result /= from_time_unit; + result += high; + + return result; } -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +#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 + +/* + * If the monotonic time unit is a compile time constant, + * it is assumed (and need) to be a power of 10. + */ + +#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT < 1000*1000 +# error Compile time time unit needs to be at least 1000000 +#endif + +#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000*1000 +/* Nano-second time unit */ + +#define ERTS_MONOTONIC_TO_SEC__(NSEC) ((NSEC) / (1000*1000*1000)) +#define ERTS_MONOTONIC_TO_MSEC__(NSEC) ((NSEC) / (1000*1000)) +#define ERTS_MONOTONIC_TO_USEC__(NSEC) ((NSEC) / 1000) +#define ERTS_MONOTONIC_TO_NSEC__(NSEC) (NSEC) + +#define ERTS_SEC_TO_MONOTONIC__(SEC) (((ErtsMonotonicTime) (SEC))*(1000*1000*1000)) +#define ERTS_MSEC_TO_MONOTONIC__(MSEC) (((ErtsMonotonicTime) (MSEC))*(1000*1000)) +#define ERTS_USEC_TO_MONOTONIC__(USEC) (((ErtsMonotonicTime) (USEC))*1000) +#define ERTS_NSEC_TO_MONOTONIC__(NSEC) ((ErtsMonotonicTime) (NSEC)) + +#elif ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000 +/* Micro-second time unit */ + +#define ERTS_MONOTONIC_TO_SEC__(USEC) ((USEC) / (1000*1000)) +#define ERTS_MONOTONIC_TO_MSEC__(USEC) ((USEC) / 1000) +#define ERTS_MONOTONIC_TO_USEC__(USEC) (USEC) +#define ERTS_MONOTONIC_TO_NSEC__(USEC) ((USEC)*1000) + +#define ERTS_SEC_TO_MONOTONIC__(SEC) (((ErtsMonotonicTime) (SEC))*(1000*1000)) +#define ERTS_MSEC_TO_MONOTONIC__(MSEC) (((ErtsMonotonicTime) (MSEC))*1000) +#define ERTS_USEC_TO_MONOTONIC__(USEC) ((ErtsMonotonicTime) (USEC)) +#define ERTS_NSEC_TO_MONOTONIC__(NSEC) (((ErtsMonotonicTime) (NSEC))/1000) + +#else +#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) \ + ((TCKS) * (ERTS_MONOTONIC_TIME_UNIT/ERTS_CLKTCK_RESOLUTION)) + +#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), \ + (Uint32) ERTS_MONOTONIC_TIME_UNIT, \ + (Uint32) (TO))) + +#define ERTS_CONV_TO_MON_UNIT___(M, FROM) \ + ((ErtsMonotonicTime) \ + erts_time_unit_conversion((Uint64) (M), \ + (Uint32) (FROM), \ + (Uint32) ERTS_MONOTONIC_TIME_UNIT)) \ + +#define ERTS_MONOTONIC_TO_SEC__(M) \ + ERTS_CONV_FROM_MON_UNIT___((M), 1) +#define ERTS_MONOTONIC_TO_MSEC__(M) \ + ERTS_CONV_FROM_MON_UNIT___((M), 1000) +#define ERTS_MONOTONIC_TO_USEC__(M) \ + ERTS_CONV_FROM_MON_UNIT___((M), 1000*1000) +#define ERTS_MONOTONIC_TO_NSEC__(M) \ + ERTS_CONV_FROM_MON_UNIT___((M), 1000*1000*1000) + +#define ERTS_SEC_TO_MONOTONIC__(SEC) \ + ERTS_CONV_TO_MON_UNIT___((SEC), 1) +#define ERTS_MSEC_TO_MONOTONIC__(MSEC) \ + ERTS_CONV_TO_MON_UNIT___((MSEC), 1000) +#define ERTS_USEC_TO_MONOTONIC__(USEC) \ + ERTS_CONV_TO_MON_UNIT___((USEC), 1000*1000) +#define ERTS_NSEC_TO_MONOTONIC__(NSEC) \ + ERTS_CONV_TO_MON_UNIT___((NSEC), 1000*1000*1000) + +#define ERTS_MONOTONIC_TO_CLKTCKS__(MON) \ + ERTS_CONV_FROM_MON_UNIT___((MON), ERTS_CLKTCK_RESOLUTION) +#define ERTS_CLKTCKS_TO_MONOTONIC__(TCKS) \ + ERTS_CONV_TO_MON_UNIT___((TCKS), ERTS_CLKTCK_RESOLUTION) + +#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) \ + ((TCKS) / (ERTS_CLKTCK_RESOLUTION/1000)) + +#define ERTS_MONOTONIC_TO_SEC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MONOTONIC_TO_SEC__((X))) +#define ERTS_MONOTONIC_TO_MSEC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MONOTONIC_TO_MSEC__((X))) +#define ERTS_MONOTONIC_TO_USEC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MONOTONIC_TO_USEC__((X))) +#define ERTS_MONOTONIC_TO_NSEC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MONOTONIC_TO_NSEC__((X))) +#define ERTS_SEC_TO_MONOTONIC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_SEC_TO_MONOTONIC__((X))) +#define ERTS_MSEC_TO_MONOTONIC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MSEC_TO_MONOTONIC__((X))) +#define ERTS_USEC_TO_MONOTONIC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_USEC_TO_MONOTONIC__((X))) +#define ERTS_NSEC_TO_MONOTONIC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_NSEC_TO_MONOTONIC__((X))) + +#define ERTS_MONOTONIC_TO_CLKTCKS(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MONOTONIC_TO_CLKTCKS__((X))) +#define ERTS_CLKTCKS_TO_MONOTONIC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_CLKTCKS_TO_MONOTONIC__((X))) + +#define ERTS_MSEC_TO_CLKTCKS(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + ERTS_MSEC_TO_CLKTCKS__((X))) +#define ERTS_CLKTCKS_TO_MSEC(X) \ + (ERTS_TIME_ASSERT((X) >= 0), \ + 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 3272a5326d..e550c999b8 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -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 @@ -18,60 +18,10 @@ */ /* -** Support routines for the timer wheel -** -** This code contains two strategies for dealing with -** date/time changes in the system. -** If the system has some kind of high resolution timer (HAVE_GETHRTIME), -** the high resolution timer is used to correct the time-of-day and the -** timeouts, the base source is the hrtimer, but at certain intervals the -** OS time-of-day is checked and if it is not within certain bounds, the -** delivered time gets slowly adjusted for each call until -** it corresponds to the system time (built-in adjtime...). -** The call gethrtime() is detected by autoconf on Unix, but other -** platforms may define it in erl_*_sys.h and implement -** their own high resolution timer. The high resolution timer -** strategy is (probably) best on all systems where the timer have -** a resolution higher or equal to gettimeofday (or what's implemented -** is sys_gettimeofday()). The actual resolution is the interesting thing, -** not the unit's thats used (i.e. on VxWorks, nanoseconds can be -** retrieved in terms of units, but the actual resolution is the same as -** for the clock ticks). -** If the systems best timer routine is kernel ticks returned from -** sys_times(), and the actual resolution of sys_gettimeofday() is -** better (like most unixes that does not have any realtime extensions), -** another strategy is used. The tolerant gettimeofday() corrects -** the value with respect to uptime (sys_times() return value) and checks -** for correction both when delivering timeticks and delivering nowtime. -** this strategy is slower, but accurate on systems without better timer -** routines. The kernel tick resolution is not enough to implement -** a gethrtime routine. On Linux and other non solaris unix-boxes the second -** strategy is used, on all other platforms we use the first. -** -** The following is expected (from sys.[ch] and erl_*_sys.h): -** -** 64 bit integers. So it is, and so it will be. -** -** sys_init_time(), will return the clock resolution in MS and -** that's about it. More could be added of course -** If the clock-rate is constant (i.e. 1 ms) one can define -** SYS_CLOCK_RESOLUTION (to 1), -** which makes erts_deliver_time/erts_time_remaining a bit faster. -** -** if HAVE_GETHRTIME is defined: -** sys_gethrtime() will return a SysHrTime (long long) representing -** nanoseconds, sys_init_hrtime() will do any initialization. -** else -** a long (64bit) integer type called Sint64 should be defined. -** -** sys_times() will return clock_ticks since start and -** fill in a SysTimes structure (struct tms). Instead of CLK_TCK, -** SYS_CLK_TCK is used to determine the resolution of kernel ticks. -** -** sys_gettimeofday() will take a SysTimeval (a struct timeval) as parameter -** and fill it in as gettimeofday(X,NULL). -** -*/ + * Support routines for the time + */ + +/* #define ERTS_TIME_CORRECTION_PRINT */ #ifdef HAVE_CONFIG_H # include "config.h" @@ -80,384 +30,1259 @@ #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 SysTimeval inittv; /* Used everywhere, the initial time-of-day */ +static erts_smp_mtx_t erts_get_time_mtx; static SysTimes t_start; /* Used in elapsed_time_both */ -static SysTimeval gtv; /* Used in wall_clock_elapsed_time_both */ -static SysTimeval then; /* Used in get_now */ -static SysTimeval last_emu_time; /* Used in erts_get_emu_time() */ -SysTimeval erts_first_emu_time; /* Used in erts_get_emu_time() */ +static ErtsMonotonicTime prev_wall_clock_elapsed; /* Used in wall_clock_elapsed_time_both */ +static ErtsMonotonicTime previous_now; /* Used in get_now */ + +static ErtsMonitor *time_offset_monitors = NULL; +static Uint no_time_offset_monitors = 0; + +#ifdef DEBUG +static int time_sup_initialized = 0; +#endif -union { - erts_smp_atomic_t time; - char align[ERTS_CACHE_LINE_SIZE]; -} approx erts_align_attribute(ERTS_CACHE_LINE_SIZE); +#define ERTS_MONOTONIC_TIME_KILO \ + ((ErtsMonotonicTime) 1000) +#define ERTS_MONOTONIC_TIME_MEGA \ + (ERTS_MONOTONIC_TIME_KILO*ERTS_MONOTONIC_TIME_KILO) +#define ERTS_MONOTONIC_TIME_GIGA \ + (ERTS_MONOTONIC_TIME_MEGA*ERTS_MONOTONIC_TIME_KILO) +#define ERTS_MONOTONIC_TIME_TERA \ + (ERTS_MONOTONIC_TIME_GIGA*ERTS_MONOTONIC_TIME_KILO) static void -init_approx_time(void) +schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset); + +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; + int os_monotonic_time_locked; + Uint64 os_monotonic_time_resolution; + Uint64 os_monotonic_time_extended; +#endif + char *os_system_time_func; + char *os_system_time_clock_id; + int os_system_time_locked; + Uint64 os_system_time_resolution; + Uint64 os_system_time_extended; + struct { + ErtsMonotonicTime large_diff; + ErtsMonotonicTime small_diff; + } adj; + struct { + ErtsMonotonicTime error; + ErtsMonotonicTime resolution; + int intervals; + int use_avg; + } drift_adj; +}; + +typedef struct { + ErtsMonotonicTime drift; /* Correction for os monotonic drift */ + ErtsMonotonicTime error; /* Correction for error between system times */ +} ErtsMonotonicCorrection; + +typedef struct { + ErtsMonotonicTime erl_mtime; + ErtsMonotonicTime os_mtime; + ErtsMonotonicCorrection correction; +} ErtsMonotonicCorrectionInstance; + +#define ERTS_MAX_DRIFT_INTERVALS 50 +typedef struct { + struct { + struct { + ErtsMonotonicTime sys; + ErtsMonotonicTime mon; + } diff; + struct { + ErtsMonotonicTime sys; + ErtsMonotonicTime mon; + } time; + } intervals[ERTS_MAX_DRIFT_INTERVALS]; + struct { + ErtsMonotonicTime sys; + ErtsMonotonicTime mon; + } acc; + int ix; + int dirty_counter; +} ErtsMonotonicDriftData; + +typedef struct { + ErtsMonotonicCorrectionInstance prev; + ErtsMonotonicCorrectionInstance curr; + ErtsMonotonicDriftData drift; + ErtsMonotonicTime last_check; + int short_check_interval; +} ErtsMonotonicCorrectionData; + +struct time_sup_infrequently_changed__ { +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + struct { + erts_smp_rwmtx_t rwmtx; + ErtsTWheelTimer timer; + ErtsMonotonicCorrectionData cdata; + } parmon; + ErtsMonotonicTime minit; +#endif + ErtsSystemTime sinit; + ErtsMonotonicTime not_corrected_moffset; + erts_smp_atomic64_t offset; + ErtsMonotonicTime shadow_offset; + erts_smp_atomic32_t preliminary_offset; +}; + +struct time_sup_frequently_changed__ { + ErtsMonotonicTime last_not_corrected_time; +}; + +static struct { + union { + struct time_sup_read_only__ o; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_read_only__))]; + } r; + union { + struct time_sup_infrequently_changed__ c; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_infrequently_changed__))]; + } inf; + union { + struct time_sup_frequently_changed__ c; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_frequently_changed__))]; + } f; +} time_sup erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +ErtsTimeSupData erts_time_sup__ erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +/* + * erts_get_approx_time() returns an *approximate* time + * in seconds. NOTE that this time may jump backwards!!! + */ +erts_approx_time_t +erts_get_approx_time(void) { - erts_smp_atomic_init_nob(&approx.time, 0); + ErtsSystemTime stime = erts_os_system_time(); + return (erts_approx_time_t) ERTS_MONOTONIC_TO_SEC(stime); } -static ERTS_INLINE erts_approx_time_t -get_approx_time(void) +static ERTS_INLINE void +init_time_offset(ErtsMonotonicTime offset) { - return (erts_approx_time_t) erts_smp_atomic_read_nob(&approx.time); + erts_smp_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset); } static ERTS_INLINE void -update_approx_time(SysTimeval *tv) +set_time_offset(ErtsMonotonicTime offset) +{ + erts_smp_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset); +} + +static ERTS_INLINE ErtsMonotonicTime +get_time_offset(void) { - erts_approx_time_t new_secs = (erts_approx_time_t) tv->tv_sec; - erts_approx_time_t old_secs = get_approx_time(); - if (old_secs != new_secs) - erts_smp_atomic_set_nob(&approx.time, new_secs); + 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 + /* - * erts_get_approx_time() returns an *approximate* time - * in seconds. NOTE that this time may jump backwards!!! + * Time correction adjustments made due to + * error between Erlang system time and OS + * system time: + * - Large adjustment ~1% + * - Small adjustment ~0.05% */ -erts_approx_time_t -erts_get_approx_time(void) +#define ERTS_TCORR_ERR_UNIT 2048 +#define ERTS_TCORR_ERR_LARGE_ADJ 20 +#define ERTS_TCORR_ERR_SMALL_ADJ 1 + +#define ERTS_INIT_SHORT_INTERVAL_COUNTER 10 +#define ERTS_LONG_TIME_CORRECTION_CHECK ERTS_SEC_TO_MONOTONIC(60) +#define ERTS_SHORT_TIME_CORRECTION_CHECK ERTS_SEC_TO_MONOTONIC(15) + +#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, + int os_drift_corrected) { - return get_approx_time(); + ErtsMonotonicTime erl_mtime, diff = os_mtime - cip->os_mtime; + ERTS_TIME_ASSERT(diff >= 0); + 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); + if (os_mdiff_p) + *os_mdiff_p = diff; + return erl_mtime; } -#ifdef HAVE_GETHRTIME +static ERTS_INLINE ErtsMonotonicTime +read_corrected_time(int os_drift_corrected) +{ + ErtsMonotonicTime os_mtime; + ErtsMonotonicCorrectionData cdata; + ErtsMonotonicCorrectionInstance *cip; -int erts_disable_tolerant_timeofday; + erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx); -static SysHrTime hr_init_time, hr_last_correction_check, - hr_correction, hr_last_time; + os_mtime = erts_os_monotonic_time(); -static void init_tolerant_timeofday(void) -{ - /* Should be in sys.c */ -#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF) - if (sysconf(_SC_NPROCESSORS_CONF) > 1) { - char b[1024]; - int maj,min,build; - os_flavor(b,1024); - os_version(&maj,&min,&build); - if (!strcmp(b,"sunos") && maj <= 5 && min <= 7) { - erts_disable_tolerant_timeofday = 1; - } + cdata = time_sup.inf.c.parmon.cdata; + + erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx); + + if (os_mtime >= cdata.curr.os_mtime) + cip = &cdata.curr; + else { + if (os_mtime < cdata.prev.os_mtime) + erl_exit(ERTS_ABORT_EXIT, + "OS monotonic time stepped backwards\n"); + cip = &cdata.prev; } -#endif - hr_init_time = sys_gethrtime(); - hr_last_correction_check = hr_last_time = hr_init_time; - hr_correction = 0; + + 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 + +static ERTS_INLINE void +print_correction(int change, + ErtsMonotonicTime sdiff, + ErtsMonotonicTime old_ecorr, + ErtsMonotonicTime old_dcorr, + ErtsMonotonicTime new_ecorr, + ErtsMonotonicTime new_dcorr, + Uint tmo) +{ + ErtsMonotonicTime usec_sdiff; + if (sdiff < 0) + usec_sdiff = -1*ERTS_MONOTONIC_TO_USEC(-1*sdiff); + else + usec_sdiff = ERTS_MONOTONIC_TO_USEC(sdiff); + + if (!change) + 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 + 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); } -static void get_tolerant_timeofday(SysTimeval *tv) +#endif + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime tmo) { - SysHrTime diff_time, curr; + ErtsMonotonicTime tpos; + tpos = ERTS_MONOTONIC_TO_CLKTCKS(now - 1); + tpos += ERTS_MSEC_TO_CLKTCKS(tmo); + tpos += 1; + return tpos; +} - if (erts_disable_tolerant_timeofday) { - sys_gettimeofday(tv); - return; +static void +check_time_correction(void *vesdp) +{ + 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, timeout_pos; + Uint timeout; + 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); + + erts_os_times(&os_mtime, &os_stime); + + cdata = time_sup.inf.c.parmon.cdata; + + erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx); + + if (os_mtime < cdata.curr.os_mtime) + erl_exit(ERTS_ABORT_EXIT, + "OS monotonic time stepped backwards\n"); + cip = &cdata.curr; + + 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; } - *tv = inittv; - diff_time = ((curr = sys_gethrtime()) + hr_correction - hr_init_time) / 1000; - if (curr < hr_init_time) { - erl_exit(1,"Unexpected behaviour from operating system high " - "resolution timer"); + 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)) { + /* System time diff exeeded limits; change time offset... */ + time_offset -= sdiff; + sdiff = 0; + 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 = 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; + } + } + else if (cdata.curr.correction.error == 0) { + if (sdiff < -time_sup.r.o.adj.small_diff) { + set_new_correction = 1; + if (sdiff < -time_sup.r.o.adj.large_diff) + new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ; + else + new_correction.error = ERTS_TCORR_ERR_SMALL_ADJ; + } + else if (sdiff > time_sup.r.o.adj.small_diff) { + set_new_correction = 1; + if (sdiff > time_sup.r.o.adj.large_diff) + new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ; + else + new_correction.error = -ERTS_TCORR_ERR_SMALL_ADJ; + } + } + else if (cdata.curr.correction.error > 0) { + if (sdiff < 0) { + 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; + } + } + else if (sdiff > time_sup.r.o.adj.small_diff) { + set_new_correction = 1; + if (sdiff > time_sup.r.o.adj.large_diff) + new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ; + else + new_correction.error = -ERTS_TCORR_ERR_SMALL_ADJ; + } + else { + set_new_correction = 1; + new_correction.error = 0; + } + } + else /* if (cdata.curr.correction.error < 0) */ { + if (0 < sdiff) { + 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; + } + } + else if (sdiff < -time_sup.r.o.adj.small_diff) { + set_new_correction = 1; + if (sdiff < -time_sup.r.o.adj.large_diff) + new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ; + else + new_correction.error = ERTS_TCORR_ERR_SMALL_ADJ; + } + else { + set_new_correction = 1; + new_correction.error = 0; + } } - if ((curr - hr_last_correction_check) / 1000 > 1000000) { - /* Check the correction need */ - SysHrTime tv_diff, diffdiff; - SysTimeval tmp; - int done = 0; - - sys_gettimeofday(&tmp); - tv_diff = ((SysHrTime) tmp.tv_sec) * 1000000 + tmp.tv_usec; - tv_diff -= ((SysHrTime) inittv.tv_sec) * 1000000 + inittv.tv_usec; - diffdiff = diff_time - tv_diff; - if (diffdiff > 10000) { - SysHrTime corr = (curr - hr_last_time) / 100; - if (corr / 1000 >= diffdiff) { - ++done; - hr_correction -= ((SysHrTime)diffdiff) * 1000; - } else { - hr_correction -= corr; + if (!os_drift_corrected) { + ErtsMonotonicDriftData *ddp = &time_sup.inf.c.parmon.cdata.drift; + int ix = ddp->ix; + ErtsMonotonicTime mtime_diff, old_os_mtime; + + old_os_mtime = ddp->intervals[ix].time.mon; + mtime_diff = os_mtime - old_os_mtime; + + if ((mtime_diff >= ERTS_MIN_MONOTONIC_DRIFT_MEASUREMENT) + | init_drift_adj) { + ErtsMonotonicTime drift_adj, drift_adj_diff, old_os_stime, + 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) + / mtime_acc); + + mtime_diff = os_mtime - old_os_mtime; + stime_diff = os_stime - old_os_stime; + smtime_diff = stime_diff - mtime_diff; + ix++; + if (ix >= time_sup.r.o.drift_adj.intervals) + ix = 0; + mtime_acc -= ddp->intervals[ix].diff.mon; + mtime_acc += mtime_diff; + stime_acc -= ddp->intervals[ix].diff.sys; + stime_acc += stime_diff; + + ddp->intervals[ix].diff.mon = mtime_diff; + ddp->intervals[ix].diff.sys = stime_diff; + ddp->intervals[ix].time.mon = os_mtime; + ddp->intervals[ix].time.sys = os_stime; + + ddp->ix = ix; + ddp->acc.mon = mtime_acc; + ddp->acc.sys = stime_acc; + + 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; } - diff_time = (curr + hr_correction - hr_init_time) / 1000; - } else if (diffdiff < -10000) { - SysHrTime corr = (curr - hr_last_time) / 100; - if (corr / 1000 >= -diffdiff) { - ++done; - hr_correction -= ((SysHrTime)diffdiff) * 1000; - } else { - hr_correction += corr; + 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; + } + 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) + drift_adj_diff = ERTS_TIME_DRIFT_MAX_ADJ_DIFF; + 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; + } + } } - diff_time = (curr + hr_correction - hr_init_time) / 1000; - } else { - ++done; } - if (done) { - hr_last_correction_check = curr; + } + + begin_short_intervals |= set_new_correction; + + if (begin_short_intervals) { + time_sup.inf.c.parmon.cdata.short_check_interval + = ERTS_INIT_SHORT_INTERVAL_COUNTER; + } + else if ((os_mtime - time_sup.inf.c.parmon.cdata.last_check + >= ERTS_SHORT_TIME_CORRECTION_CHECK - ERTS_MONOTONIC_TIME_UNIT) + && time_sup.inf.c.parmon.cdata.short_check_interval > 0) { + time_sup.inf.c.parmon.cdata.short_check_interval--; + } + time_sup.inf.c.parmon.cdata.last_check = os_mtime; + + if (new_correction.error == 0) + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK); + else { + ErtsMonotonicTime ecorr = new_correction.error; + ErtsMonotonicTime abs_sdiff; + abs_sdiff = (sdiff < 0) ? -1*sdiff : sdiff; + if (ecorr < 0) + ecorr = -1*ecorr; + 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*abs_sdiff)/ecorr); + if (timeout < 10) + timeout = 10; } } - tv->tv_sec += (int) (diff_time / ((SysHrTime) 1000000)); - tv->tv_usec += (int) (diff_time % ((SysHrTime) 1000000)); - if (tv->tv_usec >= 1000000) { - tv->tv_usec -= 1000000; - tv->tv_sec += 1; + + 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.drift.dirty_counter >= 0)) { + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK); } - hr_last_time = curr; -} -#define correction (hr_correction/1000000) + timeout_pos = get_timeout_pos(erl_mtime, timeout); -#else /* !HAVE_GETHRTIME */ -#if !defined(CORRECT_USING_TIMES) -#define init_tolerant_timeofday() -#define get_tolerant_timeofday(tvp) sys_gettimeofday(tvp) -#else +#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 -typedef Sint64 Milli; - -static clock_t init_ct; -static Sint64 ct_wrap; -static Milli init_tv_m; -static Milli correction_supress; -static Milli last_ct_diff; -static Milli last_cc; -static clock_t last_ct; - -/* sys_times() might need to be wrapped and the values shifted (right) - a bit to cope with newer linux (2.5.*) kernels, this has to be taken care - of dynamically to start with, a special version that uses - the times() return value as a high resolution timer can be made - to fully utilize the faster ticks, like on windows, but for now, we'll - settle with this silly workaround */ -#ifdef ERTS_WRAP_SYS_TIMES -#define KERNEL_TICKS() (sys_times_wrap() & \ - ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1)) -#else -SysTimes dummy_tms; + if (set_new_correction) { + erts_smp_rwmtx_rwlock(&time_sup.inf.c.parmon.rwmtx); -#define KERNEL_TICKS() (sys_times(&dummy_tms) & \ - ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1)) + os_mtime = erts_os_monotonic_time(); -#endif + /* Save previous correction instance */ + time_sup.inf.c.parmon.cdata.prev = *cip; -static void init_tolerant_timeofday(void) -{ - last_ct = init_ct = KERNEL_TICKS(); - last_cc = 0; - init_tv_m = (((Milli) inittv.tv_sec) * 1000) + - (inittv.tv_usec / 1000); - ct_wrap = 0; - correction_supress = 0; + /* + * Current correction instance begin when + * OS monotonic time has increased two units. + */ + 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, + os_drift_corrected); + + /* + * Save new current correction instance. + */ + time_sup.inf.c.parmon.cdata.curr.erl_mtime = erl_mtime; + time_sup.inf.c.parmon.cdata.curr.os_mtime = os_mtime; + time_sup.inf.c.parmon.cdata.curr.correction = new_correction; + + erts_smp_rwmtx_rwunlock(&time_sup.inf.c.parmon.rwmtx); + } + + if (!esdp) + esdp = erts_get_scheduler_data(); + + erts_twheel_set_timer(esdp->timer_wheel, + &time_sup.inf.c.parmon.timer, + check_time_correction, + NULL, + (void *) esdp, + timeout_pos); } +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 get_tolerant_timeofday(SysTimeval *tvp) +static void +check_time_offset(void *vesdp) { - clock_t current_ct; - SysTimeval current_tv; - Milli ct_diff; - Milli tv_diff; - Milli current_correction; - Milli act_correction; /* long shown to be too small */ - Milli max_adjust; - - if (erts_disable_tolerant_timeofday) { - sys_gettimeofday(tvp); - return; - } + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ErtsMonotonicTime sdiff, os_mtime, erl_mtime, os_stime, + erl_stime, time_offset, timeout, timeout_pos; -#ifdef ERTS_WRAP_SYS_TIMES -#define TICK_MS (1000 / SYS_CLK_TCK_WRAP) -#else -#define TICK_MS (1000 / SYS_CLK_TCK) + 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 - current_ct = KERNEL_TICKS(); - sys_gettimeofday(¤t_tv); - - /* I dont know if uptime can move some units backwards - on some systems, but I allow for small backward - jumps to avoid such problems if they exist...*/ - if (last_ct > 100 && current_ct < (last_ct - 100)) { - ct_wrap += ((Sint64) 1) << ((sizeof(clock_t) * 8) - 1); + time_offset -= sdiff; + sdiff = 0; + set_time_offset(time_offset); + schedule_send_time_offset_changed_notifications(time_offset); } - last_ct = current_ct; - ct_diff = ((ct_wrap + current_ct) - init_ct) * TICK_MS; +#ifdef ERTS_TIME_CORRECTION_PRINT + else erts_fprintf(stderr, "sdiff = %b64d nsec\n", + ERTS_MONOTONIC_TO_NSEC(sdiff)); +#endif - /* - * We will adjust the time in milliseconds and we allow for 1% - * adjustments, but if this function is called more often then every 100 - * millisecond (which is obviously possible), we will never adjust, so - * we accumulate small times by setting last_ct_diff iff max_adjust > 0 - */ - if ((max_adjust = (ct_diff - last_ct_diff)/100) > 0) - last_ct_diff = ct_diff; + timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK); + timeout_pos = get_timeout_pos(erl_mtime, timeout); - tv_diff = ((((Milli) current_tv.tv_sec) * 1000) + - (current_tv.tv_usec / 1000)) - init_tv_m; + erts_twheel_set_timer(esdp->timer_wheel, + &time_sup.inf.c.parmon.timer, + check_time_offset, + NULL, + vesdp, + timeout_pos); +} - current_correction = ((ct_diff - tv_diff) / TICK_MS) * TICK_MS; /* trunc */ +static void +init_check_time_correction(void *vesdp) +{ + ErtsMonotonicDriftData *ddp; + ErtsMonotonicTime old_mtime, old_stime, mtime, stime, mtime_diff, + stime_diff, smtime_diff, max_drift; + int ix; - /* - * We allow the current_correction value to wobble a little, as it - * suffers from the low resolution of the kernel ticks. - * if it hasn't changed more than one tick in either direction, - * we will keep the old value. - */ - if ((last_cc > current_correction + TICK_MS) || - (last_cc < current_correction - TICK_MS)) { - last_cc = current_correction; - } else { - current_correction = last_cc; + ddp = &time_sup.inf.c.parmon.cdata.drift; + ix = ddp->ix; + old_mtime = ddp->intervals[0].time.mon; + old_stime = ddp->intervals[0].time.sys; + + erts_os_times(&mtime, &stime); + + mtime_diff = mtime - old_mtime; + stime_diff = stime - old_stime; + 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; } /* - * As time goes, we try to get the actual correction to 0, - * that is, make erlangs time correspond to the systems dito. - * The act correction is what we seem to need (current_correction) - * minus the correction suppression. The correction supression - * will change slowly (max 1% of elapsed time) but in millisecond steps. + * We use old time values in order to trigger + * a drift adjustment, and repeat this interval + * in all slots... */ - act_correction = current_correction - correction_supress; - if (max_adjust > 0) { - /* - * Here we slowly adjust erlangs time to correspond with the - * system time by changing the correction_supress variable. - * It can change max_adjust milliseconds which is 1% of elapsed time - */ - if (act_correction > 0) { - if (current_correction - correction_supress > max_adjust) { - correction_supress += max_adjust; - } else { - correction_supress = current_correction; - } - act_correction = current_correction - correction_supress; - } else if (act_correction < 0) { - if (correction_supress - current_correction > max_adjust) { - correction_supress -= max_adjust; - } else { - correction_supress = current_correction; + 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*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 = time_sup.r.o.drift_adj.intervals; + + check_time_correction(vesdp); +} + +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); + + erts_os_times(&os_mtime, stimep); + + cdata = time_sup.inf.c.parmon.cdata; + + erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx); + + if (os_mtime < cdata.curr.os_mtime) + erl_exit(ERTS_ABORT_EXIT, + "OS monotonic time stepped backwards\n"); + cip = &cdata.curr; + + return calc_corrected_erl_mtime(os_mtime, cip, NULL, + os_drift_corrected); +} + +static void +late_init_time_correction(ErtsSchedulerData *esdp) +{ + int quick_init_drift_adj; + void (*check_func)(void *); + ErtsMonotonicTime timeout, timeout_pos; + + 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 */ + +static ErtsMonotonicTime get_not_corrected_time(void) +{ + ErtsMonotonicTime stime, mtime; + + erts_smp_mtx_lock(&erts_get_time_mtx); + + stime = erts_os_system_time(); + + mtime = stime - time_sup.inf.c.not_corrected_moffset; + + if (mtime >= time_sup.f.c.last_not_corrected_time) + time_sup.f.c.last_not_corrected_time = mtime; + else { + mtime = time_sup.f.c.last_not_corrected_time; + + if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE) { + ErtsMonotonicTime new_offset = stime - mtime; + new_offset = ERTS_MONOTONIC_TO_USEC(new_offset); + new_offset = ERTS_USEC_TO_MONOTONIC(new_offset); + if (time_sup.inf.c.not_corrected_moffset != new_offset) { + time_sup.inf.c.not_corrected_moffset = new_offset; + set_time_offset(new_offset); + schedule_send_time_offset_changed_notifications(new_offset); } - act_correction = current_correction - correction_supress; } + } - /* - * The actual correction will correct the timeval so that system - * time warps gets smothed down. - */ - current_tv.tv_sec += act_correction / 1000; - current_tv.tv_usec += (act_correction % 1000) * 1000; - - if (current_tv.tv_usec >= 1000000) { - ++current_tv.tv_sec ; - current_tv.tv_usec -= 1000000; - } else if (current_tv.tv_usec < 0) { - --current_tv.tv_sec; - current_tv.tv_usec += 1000000; - } - *tvp = current_tv; -#undef TICK_MS + + ASSERT(stime == mtime + time_sup.inf.c.not_corrected_moffset); + + erts_smp_mtx_unlock(&erts_get_time_mtx); + + return mtime; } -#endif /* CORRECT_USING_TIMES */ -#endif /* !HAVE_GETHRTIME */ +int erts_check_time_adj_support(int time_correction, + ErtsTimeWarpMode time_warp_mode) +{ + if (!time_correction) + return 1; -/* -** Why this? Well, most platforms have a constant clock resolution of 1, -** we dont want the deliver_time/time_remaining routines to waste -** time dividing and multiplying by/with a variable that's always one. -** so the return value of sys_init_time is ignored on those platforms. -*/ - -#ifndef SYS_CLOCK_RESOLUTION -static int clock_resolution; -#define CLOCK_RESOLUTION clock_resolution + /* User wants time correction */ + +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + return !time_sup.r.o.os_monotonic_time_disable; #else -#define CLOCK_RESOLUTION SYS_CLOCK_RESOLUTION + return 0; #endif +} -/* -** The clock resolution should really be the resolution of the -** time function in use, which on most platforms -** is 1. On VxWorks the resolution should be -** the number of ticks per second (or 1, which would work nicely to). -** -** Setting lower resolutions is mostly interesting when timers are used -** instead of something like select. -*/ - -static SysTimeval last_delivered; - -static void init_erts_deliver_time(const SysTimeval *inittv) +int +erts_has_time_correction(void) { - /* We set the initial values for deliver_time here */ - last_delivered = *inittv; - last_delivered.tv_usec = 1000 * (last_delivered.tv_usec / 1000); - /* ms resolution */ + return time_sup.r.o.correction; } -static void do_erts_deliver_time(const SysTimeval *current) +void erts_init_sys_time_sup(void) { - SysTimeval cur_time; - erts_time_t elapsed; - - /* calculate and deliver appropriate number of ticks */ - cur_time = *current; - cur_time.tv_usec = 1000 * (cur_time.tv_usec / 1000); /* ms resolution */ - elapsed = (1000 * (cur_time.tv_sec - last_delivered.tv_sec) + - (cur_time.tv_usec - last_delivered.tv_usec) / 1000) / - CLOCK_RESOLUTION; + ErtsSysInitTimeResult sys_init_time_res + = ERTS_SYS_INIT_TIME_RESULT_INITER; - /* Sometimes the time jump backwards, - resulting in a negative elapsed time. We compensate for - this by simply pretend as if the time stood still. :) */ + sys_init_time(&sys_init_time_res); - if (elapsed > 0) { + erts_time_sup__.r.o.monotonic_time_unit + = sys_init_time_res.os_monotonic_time_unit; - ASSERT(elapsed < ((erts_time_t) ERTS_SHORT_TIME_T_MAX)); +#ifndef SYS_CLOCK_RESOLUTION + erts_time_sup__.r.o.clktck_resolution + = sys_init_time_res.sys_clock_resolution; + erts_time_sup__.r.o.clktck_resolution *= 1000; +#endif - erts_do_time_add((erts_short_time_t) elapsed); - last_delivered = cur_time; - } +#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 + = sys_init_time_res.os_monotonic_time_info.clock_id; + time_sup.r.o.os_monotonic_time_locked + = sys_init_time_res.os_monotonic_time_info.locked_use; + time_sup.r.o.os_monotonic_time_resolution + = sys_init_time_res.os_monotonic_time_info.resolution; + time_sup.r.o.os_monotonic_time_extended + = sys_init_time_res.os_monotonic_time_info.extended; +#endif + time_sup.r.o.os_system_time_func + = sys_init_time_res.os_system_time_info.func; + time_sup.r.o.os_system_time_clock_id + = sys_init_time_res.os_system_time_info.clock_id; + time_sup.r.o.os_system_time_locked + = sys_init_time_res.os_system_time_info.locked_use; + time_sup.r.o.os_system_time_resolution + = sys_init_time_res.os_system_time_info.resolution; } int -erts_init_time_sup(void) +erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) { + 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"); + erts_smp_mtx_init(&erts_get_time_mtx, "get_time"); - init_approx_time(); + time_sup.r.o.correction = time_correction; + time_sup.r.o.warp_mode = time_warp_mode; + + if (time_warp_mode == ERTS_SINGLE_TIME_WARP_MODE) + erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 1); + else + erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 0); + time_sup.inf.c.shadow_offset = 0; - last_emu_time.tv_sec = 0; - last_emu_time.tv_usec = 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 + 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) { + erts_time_sup__.r.o.start = 0; + native_offset = -ERTS_MONOTONIC_BEGIN; + abs_native_offset = ERTS_MONOTONIC_BEGIN; + } + else { + 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 + + 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); + 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); + erts_time_sup__.r.o.start_offset.msec = (ErtsMonotonicTime) + erts_time_unit_conversion((Uint64) abs_native_offset, + (Uint32) ERTS_MONOTONIC_TIME_UNIT, + (Uint32) 1000); + 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) { + 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; + } -#ifndef SYS_CLOCK_RESOLUTION - clock_resolution = sys_init_time(); -#else - (void) sys_init_time(); #endif - sys_gettimeofday(&inittv); + + resolution = time_sup.r.o.os_system_time_resolution; +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + if (resolution > time_sup.r.o.os_monotonic_time_resolution) + resolution = time_sup.r.o.os_monotonic_time_resolution; +#endif + + time_sup.r.o.adj.large_diff = erts_time_sup__.r.o.monotonic_time_unit; + time_sup.r.o.adj.large_diff *= 50; + time_sup.r.o.adj.large_diff /= resolution; + if (time_sup.r.o.adj.large_diff < ERTS_USEC_TO_MONOTONIC(500)) + 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 + 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) + ERTS_INTERNAL_ERROR("Too small monotonic time time unit"); + +#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + time_sup.r.o.correction = 0; +#else + if (time_sup.r.o.os_monotonic_time_disable) + time_sup.r.o.correction = 0; + + if (time_sup.r.o.correction) { + ErtsMonotonicCorrectionData *cdatap; + erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; + ErtsMonotonicTime offset; + 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_BEGIN; + init_time_offset(offset); + + rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; + rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED; + + erts_smp_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx, + &rwmtx_opts, "get_corrected_time"); + + cdatap = &time_sup.inf.c.parmon.cdata; -#ifdef HAVE_GETHRTIME - sys_init_hrtime(); + 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; + cdatap->curr.correction.error = 0; + 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; + + 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 - init_tolerant_timeofday(); + { + 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_BEGIN; + time_sup.inf.c.not_corrected_moffset = offset; + init_time_offset(offset); + time_sup.f.c.last_not_corrected_time = 0; + } + + prev_wall_clock_elapsed = 0; - init_erts_deliver_time(&inittv); - gtv = inittv; - then.tv_sec = then.tv_usec = 0; + previous_now = ERTS_MONOTONIC_TO_USEC(get_time_offset()); - erts_deliver_time(); +#ifdef DEBUG + time_sup_initialized = 1; +#endif - return CLOCK_RESOLUTION; + return ERTS_CLKTCK_RESOLUTION/1000; } + +void +erts_late_init_time_sup(void) +{ + 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; +} + +ErtsTimeOffsetState erts_time_offset_state(void) +{ + switch (time_sup.r.o.warp_mode) { + case ERTS_NO_TIME_WARP_MODE: + return ERTS_TIME_OFFSET_FINAL; + case ERTS_SINGLE_TIME_WARP_MODE: + 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: + ERTS_INTERNAL_ERROR("Invalid time warp mode"); + return ERTS_TIME_OFFSET_VOLATILE; + } +} + +/* + * erts_finalize_time_offset() will only change time offset + * the first time it is called when the emulator has been + * started in "single time warp" mode. Returns previous + * state: + * * ERTS_TIME_OFFSET_PRELIMINARY - Finalization performed + * * ERTS_TIME_OFFSET_FINAL - Already finialized; nothing changed + * * ERTS_TIME_OFFSET_VOLATILE - Not supported, either in + * * no correction mode (or multi time warp mode; not yet implemented). + */ + +ErtsTimeOffsetState +erts_finalize_time_offset(void) +{ + switch (time_sup.r.o.warp_mode) { + case ERTS_NO_TIME_WARP_MODE: + return ERTS_TIME_OFFSET_FINAL; + case ERTS_MULTI_TIME_WARP_MODE: + return ERTS_TIME_OFFSET_VOLATILE; + case ERTS_SINGLE_TIME_WARP_MODE: { + ErtsTimeOffsetState res = ERTS_TIME_OFFSET_FINAL; + + erts_smp_mtx_lock(&erts_get_time_mtx); + + if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) { + ErtsMonotonicTime mtime, new_offset; + +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + if (!time_sup.r.o.correction) +#endif + { + ErtsMonotonicTime stime = erts_os_system_time(); + + mtime = stime - time_sup.inf.c.not_corrected_moffset; + + if (mtime >= time_sup.f.c.last_not_corrected_time) { + time_sup.f.c.last_not_corrected_time = mtime; + new_offset = time_sup.inf.c.not_corrected_moffset; + } + else { + mtime = time_sup.f.c.last_not_corrected_time; + + ASSERT(time_sup.inf.c.not_corrected_moffset != stime - mtime); + new_offset = stime - mtime; + time_sup.inf.c.not_corrected_moffset = new_offset; + } + + } +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + else { + ErtsSystemTime stime; + mtime = finalize_corrected_time_offset(&stime); + new_offset = stime - mtime; + } +#endif + new_offset = ERTS_MONOTONIC_TO_USEC(new_offset); + new_offset = ERTS_USEC_TO_MONOTONIC(new_offset); + + set_time_offset(new_offset); + schedule_send_time_offset_changed_notifications(new_offset); + + 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); + + return res; + } + default: + ERTS_INTERNAL_ERROR("Invalid time warp mode"); + return ERTS_TIME_OFFSET_VOLATILE; + } +} + /* info functions */ void @@ -498,23 +1323,17 @@ elapsed_time_both(UWord *ms_user, UWord *ms_sys, void wall_clock_elapsed_time_both(UWord *ms_total, UWord *ms_diff) { - UWord prev_total; - SysTimeval tv; + ErtsMonotonicTime now, elapsed; erts_smp_mtx_lock(&erts_timeofday_mtx); - get_tolerant_timeofday(&tv); - - *ms_total = 1000 * (tv.tv_sec - inittv.tv_sec) + - (tv.tv_usec - inittv.tv_usec) / 1000; + now = time_sup.r.o.get_time(); + update_last_mtime(NULL, now); - prev_total = 1000 * (gtv.tv_sec - inittv.tv_sec) + - (gtv.tv_usec - inittv.tv_usec) / 1000; - *ms_diff = *ms_total - prev_total; - gtv = tv; - - /* must sync the machine's idea of time here */ - do_erts_deliver_time(&tv); + elapsed = ERTS_MONOTONIC_TO_MSEC(now); + *ms_total = (UWord) elapsed; + *ms_diff = (UWord) (elapsed - prev_wall_clock_elapsed); + prev_wall_clock_elapsed = elapsed; erts_smp_mtx_unlock(&erts_timeofday_mtx); } @@ -890,146 +1709,566 @@ univ_to_local(Sint *year, Sint *month, Sint *day, return 0; } - /* get a timestamp */ void get_now(Uint* megasec, Uint* sec, Uint* microsec) { - SysTimeval now; + ErtsMonotonicTime now_megasec, now_sec, now, mtime, time_offset; + mtime = time_sup.r.o.get_time(); + time_offset = get_time_offset(); + update_last_mtime(NULL, mtime); + now = ERTS_MONOTONIC_TO_USEC(mtime + time_offset); + erts_smp_mtx_lock(&erts_timeofday_mtx); - - get_tolerant_timeofday(&now); - do_erts_deliver_time(&now); - - /* Make sure time is later than last */ - if (then.tv_sec > now.tv_sec || - (then.tv_sec == now.tv_sec && then.tv_usec >= now.tv_usec)) { - now = then; - now.tv_usec++; - } - /* Check for carry from above + general reasonability */ - if (now.tv_usec >= 1000000) { - now.tv_usec = 0; - now.tv_sec++; - } - then = now; + + /* Make sure now time is later than last time */ + if (now <= previous_now) + now = previous_now + 1; + + previous_now = now; erts_smp_mtx_unlock(&erts_timeofday_mtx); - - *megasec = (Uint) (now.tv_sec / 1000000); - *sec = (Uint) (now.tv_sec % 1000000); - *microsec = (Uint) (now.tv_usec); - update_approx_time(&now); + now_megasec = now / ERTS_MONOTONIC_TIME_TERA; + now_sec = now / ERTS_MONOTONIC_TIME_MEGA; + *megasec = (Uint) now_megasec; + *sec = (Uint) (now_sec - now_megasec*ERTS_MONOTONIC_TIME_MEGA); + *microsec = (Uint) (now - now_sec*ERTS_MONOTONIC_TIME_MEGA); + + ASSERT(((ErtsMonotonicTime) *megasec)*ERTS_MONOTONIC_TIME_TERA + + ((ErtsMonotonicTime) *sec)*ERTS_MONOTONIC_TIME_MEGA + + ((ErtsMonotonicTime) *microsec) == now); +} + +ErtsMonotonicTime +erts_get_monotonic_time(ErtsSchedulerData *esdp) +{ + ErtsMonotonicTime mtime = time_sup.r.o.get_time(); + update_last_mtime(esdp, mtime); + return mtime; } void get_sys_now(Uint* megasec, Uint* sec, Uint* microsec) { - SysTimeval now; - - sys_gettimeofday(&now); - - *megasec = (Uint) (now.tv_sec / 1000000); - *sec = (Uint) (now.tv_sec % 1000000); - *microsec = (Uint) (now.tv_usec); + ErtsSystemTime stime = erts_os_system_time(); + ErtsSystemTime ms, s, us; + + us = ERTS_MONOTONIC_TO_USEC(stime); + s = us / (1000*1000); + ms = s / (1000*1000); - update_approx_time(&now); + *megasec = (Uint) ms; + *sec = (Uint) (s - ms*(1000*1000)); + *microsec = (Uint) (us - s*(1000*1000)); } +#ifdef HAVE_ERTS_NOW_CPU +void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) { + SysCpuTime t; + SysTimespec tp; -/* deliver elapsed *ticks* to the machine - takes a pointer - to a struct timeval representing current time (to save - a gettimeofday() where possible) or NULL */ + sys_get_proc_cputime(t, tp); + *microsec = (Uint)(tp.tv_nsec / 1000); + t = (tp.tv_sec / 1000000); + *megasec = (Uint)(t % 1000000); + *sec = (Uint)(tp.tv_sec % 1000000); +} +#endif -void erts_deliver_time(void) { - SysTimeval now; - - erts_smp_mtx_lock(&erts_timeofday_mtx); - - get_tolerant_timeofday(&now); - do_erts_deliver_time(&now); - - erts_smp_mtx_unlock(&erts_timeofday_mtx); +#include "big.h" + +void +erts_monitor_time_offset(Eterm id, Eterm ref) +{ + erts_smp_mtx_lock(&erts_get_time_mtx); + erts_add_monitor(&time_offset_monitors, MON_TIME_OFFSET, ref, id, NIL); + no_time_offset_monitors++; + erts_smp_mtx_unlock(&erts_get_time_mtx); +} - update_approx_time(&now); +int +erts_demonitor_time_offset(Eterm ref) +{ + int res; + ErtsMonitor *mon; + ASSERT(is_internal_ref(ref)); + erts_smp_mtx_lock(&erts_get_time_mtx); + mon = erts_remove_monitor(&time_offset_monitors, ref); + if (!mon) + res = 0; + else { + ASSERT(no_time_offset_monitors > 0); + no_time_offset_monitors--; + res = 1; + } + erts_smp_mtx_unlock(&erts_get_time_mtx); + if (res) + erts_destroy_monitor(mon); + return res; } -/* get *real* time (not ticks) remaining until next timeout - if there - isn't one, give a "long" time, that is guaranteed - to not cause overflow when we report elapsed time later on */ +typedef struct { + Eterm pid; + Eterm ref; + Eterm heap[REF_THING_SIZE]; +} ErtsTimeOffsetMonitorInfo; -void erts_time_remaining(SysTimeval *rem_time) +typedef struct { + Uint ix; + ErtsTimeOffsetMonitorInfo *to_mon_info; +} ErtsTimeOffsetMonitorContext; + +static void +save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt) { - erts_time_t ticks; - SysTimeval cur_time; - erts_time_t elapsed; - - /* erts_next_time() returns no of ticks to next timeout or -1 if none */ - - ticks = (erts_time_t) erts_next_time(); - if (ticks == (erts_time_t) -1) { - /* timer queue empty */ - /* this will cause at most 100000000 ticks */ - rem_time->tv_sec = 100000; - rem_time->tv_usec = 0; - } else { - /* next timeout after ticks ticks */ - ticks *= CLOCK_RESOLUTION; - - erts_smp_mtx_lock(&erts_timeofday_mtx); - - get_tolerant_timeofday(&cur_time); - cur_time.tv_usec = 1000 * - (cur_time.tv_usec / 1000);/* ms resolution*/ - elapsed = 1000 * (cur_time.tv_sec - last_delivered.tv_sec) + - (cur_time.tv_usec - last_delivered.tv_usec) / 1000; - - erts_smp_mtx_unlock(&erts_timeofday_mtx); + ErtsTimeOffsetMonitorContext *cntxt; + Eterm *from_hp, *to_hp; + Uint mix; + int hix; + + cntxt = (ErtsTimeOffsetMonitorContext *) vcntxt; + mix = (cntxt->ix)++; + cntxt->to_mon_info[mix].pid = mon->pid; + to_hp = &cntxt->to_mon_info[mix].heap[0]; + + ASSERT(is_internal_ref(mon->ref)); + from_hp = internal_ref_val(mon->ref); + ASSERT(thing_arityval(*from_hp) + 1 == REF_THING_SIZE); + + for (hix = 0; hix < REF_THING_SIZE; hix++) + to_hp[hix] = from_hp[hix]; + + cntxt->to_mon_info[mix].ref + = make_internal_ref(&cntxt->to_mon_info[mix].heap[0]); + +} + +static void +send_time_offset_changed_notifications(void *new_offsetp) +{ + ErtsMonotonicTime new_offset; + ErtsTimeOffsetMonitorInfo *to_mon_info = NULL; /* Shut up faulty warning */ + Uint no_monitors; + char *tmp = NULL; + +#ifdef ARCH_64 + new_offset = (ErtsMonotonicTime) new_offsetp; +#else + new_offset = *((ErtsMonotonicTime *) new_offsetp); + erts_free(ERTS_ALC_T_NEW_TIME_OFFSET, new_offsetp); +#endif + new_offset -= ERTS_MONOTONIC_OFFSET_NATIVE; + + erts_smp_mtx_lock(&erts_get_time_mtx); + + no_monitors = no_time_offset_monitors; + if (no_monitors) { + ErtsTimeOffsetMonitorContext cntxt; + Uint alloc_sz; - if (ticks <= elapsed) { /* Ooops, better hurry */ - rem_time->tv_sec = rem_time->tv_usec = 0; - return; + /* Monitor info array size */ + alloc_sz = no_monitors*sizeof(ErtsTimeOffsetMonitorInfo); + /* + template max size */ + alloc_sz += 6*sizeof(Eterm); /* 5-tuple */ + alloc_sz += ERTS_MAX_SINT64_HEAP_SIZE*sizeof(Eterm); /* max offset size */ + tmp = erts_alloc(ERTS_ALC_T_TMP, alloc_sz); + + to_mon_info = (ErtsTimeOffsetMonitorInfo *) tmp; + cntxt.ix = 0; + cntxt.to_mon_info = to_mon_info; + + erts_doforall_monitors(time_offset_monitors, + save_time_offset_monitor, + &cntxt); + + ASSERT(cntxt.ix == no_monitors); + } + + erts_smp_mtx_unlock(&erts_get_time_mtx); + + if (no_monitors) { + Eterm *hp, *patch_refp, new_offset_term, message_template; + Uint mix, hsz; + + /* Make message template */ + + hp = (Eterm *) (tmp + no_monitors*sizeof(ErtsTimeOffsetMonitorInfo)); + + hsz = 6; /* 5-tuple */ + hsz += REF_THING_SIZE; + hsz += ERTS_SINT64_HEAP_SIZE(new_offset); + + if (IS_SSMALL(new_offset)) + new_offset_term = make_small(new_offset); + else + new_offset_term = erts_sint64_to_big(new_offset, &hp); + message_template = TUPLE5(hp, + am_CHANGE, + THE_NON_VALUE, /* Patch point for ref */ + am_time_offset, + am_clock_service, + new_offset_term); + patch_refp = &hp[2]; + + ASSERT(*patch_refp == THE_NON_VALUE); + + for (mix = 0; mix < no_monitors; mix++) { + Process *rp = erts_proc_lookup(to_mon_info[mix].pid); + if (rp) { + Eterm ref = to_mon_info[mix].ref; + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK); + if (erts_lookup_monitor(ERTS_P_MONITORS(rp), ref)) { + ErlHeapFragment *bp; + ErlOffHeap *ohp; + Eterm message; + + hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks); + *patch_refp = ref; + ASSERT(hsz == size_object(message_template)); + message = copy_struct(message_template, hsz, &hp, ohp); + erts_queue_message(rp, &rp_locks, bp, message, NIL); + } + erts_smp_proc_unlock(rp, rp_locks); + } } - rem_time->tv_sec = (ticks - elapsed) / 1000; - rem_time->tv_usec = 1000 * ((ticks - elapsed) % 1000); + + erts_free(ERTS_ALC_T_TMP, tmp); } } -void erts_get_timeval(SysTimeval *tv) +static void +schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset) { - erts_smp_mtx_lock(&erts_timeofday_mtx); - get_tolerant_timeofday(tv); - erts_smp_mtx_unlock(&erts_timeofday_mtx); - update_approx_time(tv); +#ifdef ARCH_64 + void *new_offsetp = (void *) new_offset; + ASSERT(sizeof(void *) == sizeof(ErtsMonotonicTime)); +#else + void *new_offsetp = erts_alloc(ERTS_ALC_T_NEW_TIME_OFFSET, + sizeof(ErtsMonotonicTime)); + *((ErtsMonotonicTime *) new_offsetp) = new_offset; +#endif + erts_schedule_misc_aux_work(1, + send_time_offset_changed_notifications, + new_offsetp); } -erts_time_t -erts_get_time(void) +static ERTS_INLINE Eterm +make_time_val(Process *c_p, ErtsMonotonicTime time_val) { - SysTimeval sys_tv; - - erts_smp_mtx_lock(&erts_timeofday_mtx); - - get_tolerant_timeofday(&sys_tv); - - erts_smp_mtx_unlock(&erts_timeofday_mtx); + Sint64 val = (Sint64) time_val; + Eterm *hp; + Uint sz; - update_approx_time(&sys_tv); + if (IS_SSMALL(val)) + return make_small(val); - return sys_tv.tv_sec; + sz = ERTS_SINT64_HEAP_SIZE(val); + hp = HAlloc(c_p, sz); + return erts_sint64_to_big(val, &hp); } -#ifdef HAVE_ERTS_NOW_CPU -void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) { - SysCpuTime t; - SysTimespec tp; +Eterm +erts_get_monotonic_start_time(struct process *c_p) +{ + return make_time_val(c_p, ERTS_MONOTONIC_TIME_START_EXTERNAL); +} - sys_get_proc_cputime(t, tp); - *microsec = (Uint)(tp.tv_nsec / 1000); - t = (tp.tv_sec / 1000000); - *megasec = (Uint)(t % 1000000); - *sec = (Uint)(tp.tv_sec % 1000000); +Eterm +erts_get_monotonic_end_time(struct process *c_p) +{ + return make_time_val(c_p, ERTS_MONOTONIC_TIME_END_EXTERNAL); +} + +static Eterm +bld_monotonic_time_source(Uint **hpp, Uint *szp, Sint64 os_mtime) +{ +#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + return NIL; +#else + int i = 0; + Eterm k[6]; + Eterm v[6]; + + if (time_sup.r.o.os_monotonic_time_disable) + return NIL; + + k[i] = erts_bld_atom(hpp, szp, "function"); + v[i++] = erts_bld_atom(hpp, szp, + time_sup.r.o.os_monotonic_time_func); + + if (time_sup.r.o.os_monotonic_time_clock_id) { + k[i] = erts_bld_atom(hpp, szp, "clock_id"); + v[i++] = erts_bld_atom(hpp, szp, + time_sup.r.o.os_monotonic_time_clock_id); + } + + k[i] = erts_bld_atom(hpp, szp, "resolution"); + v[i++] = erts_bld_uint64(hpp, szp, + time_sup.r.o.os_monotonic_time_resolution); + + k[i] = erts_bld_atom(hpp, szp, "extended"); + v[i++] = time_sup.r.o.os_monotonic_time_extended ? am_yes : am_no; + + k[i] = erts_bld_atom(hpp, szp, "parallel"); + v[i++] = time_sup.r.o.os_monotonic_time_locked ? am_no : am_yes; + + k[i] = erts_bld_atom(hpp, szp, "time"); + v[i++] = erts_bld_sint64(hpp, szp, os_mtime); + + return erts_bld_2tup_list(hpp, szp, (Sint) i, k, v); +#endif } + +Eterm +erts_monotonic_time_source(struct process *c_p) +{ + Uint hsz = 0; + Eterm *hp = NULL; + Sint64 os_mtime = 0; +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + if (!time_sup.r.o.os_monotonic_time_disable) + os_mtime = (Sint64) erts_os_monotonic_time(); +#endif + + bld_monotonic_time_source(NULL, &hsz, os_mtime); + if (hsz) + hp = HAlloc(c_p, hsz); + return bld_monotonic_time_source(&hp, NULL, os_mtime); +} + +static Eterm +bld_system_time_source(Uint **hpp, Uint *szp, Sint64 os_stime) +{ + int i = 0; + Eterm k[5]; + Eterm v[5]; + + k[i] = erts_bld_atom(hpp, szp, "function"); + v[i++] = erts_bld_atom(hpp, szp, + time_sup.r.o.os_system_time_func); + + if (time_sup.r.o.os_system_time_clock_id) { + k[i] = erts_bld_atom(hpp, szp, "clock_id"); + v[i++] = erts_bld_atom(hpp, szp, + time_sup.r.o.os_system_time_clock_id); + } + + k[i] = erts_bld_atom(hpp, szp, "resolution"); + v[i++] = erts_bld_uint64(hpp, szp, + time_sup.r.o.os_system_time_resolution); + + k[i] = erts_bld_atom(hpp, szp, "parallel"); + v[i++] = am_yes; + + k[i] = erts_bld_atom(hpp, szp, "time"); + v[i++] = erts_bld_sint64(hpp, szp, os_stime); + + return erts_bld_2tup_list(hpp, szp, (Sint) i, k, v); +} + +Eterm +erts_system_time_source(struct process *c_p) +{ + Uint hsz = 0; + Eterm *hp = NULL; + Sint64 os_stime = (Sint64) erts_os_system_time(); + + bld_system_time_source(NULL, &hsz, os_stime); + if (hsz) + hp = HAlloc(c_p, hsz); + return bld_system_time_source(&hp, NULL, os_stime); +} + + +#include "bif.h" + +static ERTS_INLINE Eterm +time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonotonicTime muloff) +{ + ErtsMonotonicTime result; + BIF_RETTYPE ret; + + if (val < 0) + goto trap_to_erlang_code; + + /* Convert to common user specified time units */ + switch (term) { + case am_seconds: + case make_small(1): + result = ERTS_MONOTONIC_TO_SEC(val) + muloff*ERTS_MONOTONIC_OFFSET_SEC; + ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result)); + break; + case am_milli_seconds: + case make_small(1000): + result = ERTS_MONOTONIC_TO_MSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_MSEC; + ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result)); + break; + case am_micro_seconds: + case make_small(1000*1000): + result = ERTS_MONOTONIC_TO_USEC(val) + muloff*ERTS_MONOTONIC_OFFSET_USEC; + ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result)); + break; +#ifdef ARCH_64 + case am_nano_seconds: + case make_small(1000*1000*1000): + result = ERTS_MONOTONIC_TO_NSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_NSEC; + ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result)); + break; #endif + default: { + Eterm value, native_res; +#ifndef ARCH_64 + Sint user_res; + if (term == am_nano_seconds) + goto to_nano_seconds; + if (term_to_Sint(term, &user_res)) { + if (user_res == 1000*1000*1000) { + to_nano_seconds: + result = (ERTS_MONOTONIC_TO_NSEC(val) + + muloff*ERTS_MONOTONIC_OFFSET_NSEC); + ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result)); + break; + } + if (user_res <= 0) + goto badarg; + } +#else + if (is_small(term)) { + if (signed_val(term) <= 0) + goto badarg; + } +#endif + else if (is_big(term)) { + if (big_sign(term)) + goto badarg; + } + else { + badarg: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + break; + } + + trap_to_erlang_code: + /* Do it in erlang code instead; pass along values to use... */ + value = make_time_val(c_p, val + muloff*ERTS_MONOTONIC_OFFSET_NATIVE); + native_res = make_time_val(c_p, ERTS_MONOTONIC_TIME_UNIT); + + ERTS_BIF_PREP_TRAP3(ret, erts_convert_time_unit_trap, c_p, + value, native_res, term); + + break; + } + } + + return ret; +} + +/* Built in functions */ + +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) +{ + 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) +{ + 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)); +} + +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)); +} + +BIF_RETTYPE erts_internal_time_unit_0(BIF_ALIST_0) +{ + BIF_RET(make_time_val(BIF_P, ERTS_MONOTONIC_TIME_UNIT)); +} + +BIF_RETTYPE time_offset_0(BIF_ALIST_0) +{ + ErtsMonotonicTime time_offset = get_time_offset(); + time_offset -= ERTS_MONOTONIC_OFFSET_NATIVE; + BIF_RET(make_time_val(BIF_P, time_offset)); +} + +BIF_RETTYPE time_offset_1(BIF_ALIST_1) +{ + BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, get_time_offset(), -1)); +} + + +BIF_RETTYPE timestamp_0(BIF_ALIST_0) +{ + Eterm *hp, res; + ErtsMonotonicTime stime, mtime, all_sec, offset; + Uint mega_sec, sec, micro_sec; + + mtime = time_sup.r.o.get_time(); + offset = get_time_offset(); + update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); + stime = ERTS_MONOTONIC_TO_USEC(mtime + offset); + all_sec = stime / ERTS_MONOTONIC_TIME_MEGA; + mega_sec = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA); + sec = (Uint) (all_sec - (((ErtsMonotonicTime) mega_sec) + * ERTS_MONOTONIC_TIME_MEGA)); + micro_sec = (Uint) (stime - all_sec*ERTS_MONOTONIC_TIME_MEGA); + + ASSERT(((ErtsMonotonicTime) mega_sec)*ERTS_MONOTONIC_TIME_TERA + + ((ErtsMonotonicTime) sec)*ERTS_MONOTONIC_TIME_MEGA + + micro_sec == stime); + + /* + * Mega seconds is the only value that potentially + * ever could be a bignum. However, that wont happen + * during at least the next 4 million years... + * + * (System time will also have wrapped in the + * 64-bit integer before we get there...) + */ + + ASSERT(IS_USMALL(0, mega_sec)); + ASSERT(IS_USMALL(0, sec)); + ASSERT(IS_USMALL(0, micro_sec)); + + hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, + make_small(mega_sec), + make_small(sec), + make_small(micro_sec)); + BIF_RET(res); +} + +BIF_RETTYPE os_system_time_0(BIF_ALIST_0) +{ + ErtsSystemTime stime = erts_os_system_time(); + BIF_RET(make_time_val(BIF_P, stime)); +} + +BIF_RETTYPE os_system_time_1(BIF_ALIST_0) +{ + ErtsSystemTime stime = erts_os_system_time(); + BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0)); +} + diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 2f9969b0e7..aaecc5a02e 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -130,14 +130,9 @@ do { \ enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \ } while(0) #else -#ifdef USE_VM_PROBES -#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ - erts_queue_message((TPROC), NULL, (BP), (MSG), NIL, NIL) -#else #define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ erts_queue_message((TPROC), NULL, (BP), (MSG), NIL) #endif -#endif /* * NOTE that the ERTS_GET_TRACER_REF() returns from the function (!!!) @@ -636,11 +631,7 @@ profile_send(Eterm from, Eterm message) { hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0); msg = copy_struct(message, sz, &hp, &bp->off_heap); - erts_queue_message(profile_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(profile_p, NULL, bp, msg, NIL); } } @@ -1240,11 +1231,8 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp); erts_smp_mtx_unlock(&smq_mtx); #else - erts_queue_message(tracer, NULL, bp, mess, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); /* trace_token must be NIL here */ + /* trace_token must be NIL here */ + erts_queue_message(tracer, NULL, bp, mess, NIL); #endif } } @@ -2343,11 +2331,7 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(monitor_p, NULL, bp, msg, NIL); #endif } void @@ -2408,11 +2392,7 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(monitor_p, NULL, bp, msg, NIL); #endif } @@ -2483,11 +2463,7 @@ monitor_long_gc(Process *p, Uint time) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(monitor_p, NULL, bp, msg, NIL); #endif } @@ -2558,11 +2534,7 @@ monitor_large_heap(Process *p) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(monitor_p, NULL, bp, msg, NIL); #endif } @@ -2590,11 +2562,7 @@ monitor_generic(Process *p, Eterm type, Eterm spec) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(monitor_p, NULL, bp, msg, NIL); #endif } @@ -3389,11 +3357,7 @@ sys_msg_dispatcher_func(void *unused) } else { queue_proc_msg: - erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "delivered\n"); #endif diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index c32f8fd61c..6a28105cb9 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -113,12 +113,14 @@ void erts_silence_warn_unused_result(long unused); int erts_fit_in_bits_int64(Sint64); int erts_fit_in_bits_int32(Sint32); +int erts_fit_in_bits_uint(Uint); int erts_list_length(Eterm); int erts_is_builtin(Eterm, Eterm, int); Uint32 make_broken_hash(Eterm); Uint32 block_hash(byte *, unsigned, Uint32); Uint32 make_hash2(Eterm); Uint32 make_hash(Eterm); +Uint32 make_internal_hash(Eterm); void erts_save_emu_args(int argc, char **argv); Eterm erts_get_emu_args(struct process *c_p); @@ -165,24 +167,26 @@ int eq(Eterm, Eterm); #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) #if HALFWORD_HEAP -Sint erts_cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int); -#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0) -#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1) -#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0) -#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1) +Sint erts_cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int, int); +#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0,0) +#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1,0) +#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,0) +#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1,0) +#define CMP_EQ_ONLY(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,1) #else -Sint cmp(Eterm, Eterm); -Sint erts_cmp(Eterm, Eterm, int); -#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0) -#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1) -#define CMP(A,B) erts_cmp(A,B,0) -#define CMP_TERM(A,B) erts_cmp(A,B,1) +Sint erts_cmp(Eterm, Eterm, int, int); +Sint cmp(Eterm a, Eterm b); +#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0,0) +#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1,0) +#define CMP(A,B) erts_cmp(A,B,0,0) +#define CMP_TERM(A,B) erts_cmp(A,B,1,0) +#define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1) #endif #define cmp_lt(a,b) (CMP((a),(b)) < 0) #define cmp_le(a,b) (CMP((a),(b)) <= 0) -#define cmp_eq(a,b) (CMP((a),(b)) == 0) -#define cmp_ne(a,b) (CMP((a),(b)) != 0) +#define cmp_eq(a,b) (CMP_EQ_ONLY((a),(b)) == 0) +#define cmp_ne(a,b) (CMP_EQ_ONLY((a),(b)) != 0) #define cmp_ge(a,b) (CMP((a),(b)) >= 0) #define cmp_gt(a,b) (CMP((a),(b)) > 0) diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 78d98229d8..3a9fb1e07b 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -117,9 +117,9 @@ #if defined(DEBUG) || defined(CHECK_FOR_HOLES) #if HALFWORD_HEAP -# define ERTS_HOLE_MARKER (0xaf5e78ccU) +# define ERTS_HOLE_MARKER (0xdeadbeef) #else -# define ERTS_HOLE_MARKER (((0xaf5e78ccUL << 24) << 8) | 0xaf5e78ccUL) +# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef) #endif #endif @@ -172,6 +172,7 @@ extern int H_MIN_SIZE; /* minimum (heap + stack) */ extern int BIN_VH_MIN_SIZE; /* minimum virtual (bin) heap */ extern int erts_atom_table_size;/* Atom table size */ +extern int erts_pd_initial_size;/* Initial Process dictionary table size */ #define ORIG_CREATION 0 #define INTERNAL_CREATION 255 diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h index ddc2c1396d..e63967adb6 100644 --- a/erts/emulator/beam/error.h +++ b/erts/emulator/beam/error.h @@ -140,7 +140,13 @@ #define EXC_NOTSUP ((17 << 8) | EXC_ERROR) /* Not supported */ -#define NUMBER_EXIT_CODES 18 /* The number of exit code indices */ +#define EXC_BADMAP ((18 << 8) | EXC_ERROR) + /* Bad map */ + +#define EXC_BADKEY ((19 << 8) | EXC_ERROR) + /* Bad key in map */ + +#define NUMBER_EXIT_CODES 20 /* The number of exit code indices */ /* * Internal pseudo-error codes. @@ -152,6 +158,8 @@ */ #define BADARG EXC_BADARG #define BADARITH EXC_BADARITH +#define BADKEY EXC_BADKEY +#define BADMAP EXC_BADMAP #define BADMATCH EXC_BADMATCH #define SYSTEM_LIMIT EXC_SYSTEM_LIMIT diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 601cbe9d7d..fe48298155 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1182,7 +1182,8 @@ typedef struct { Eterm* hp_end; int remaining_n; char* remaining_bytes; - Eterm* maps_head; + Eterm* maps_list; + struct dec_term_hamt_placeholder* hamt_list; } B2TDecodeContext; typedef struct { @@ -1508,7 +1509,8 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar ctx->u.dc.hp_start = HAlloc(p, ctx->heap_size); ctx->u.dc.hp = ctx->u.dc.hp_start; ctx->u.dc.hp_end = ctx->u.dc.hp_start + ctx->heap_size; - ctx->u.dc.maps_head = NULL; + ctx->u.dc.maps_list = NULL; + ctx->u.dc.hamt_list = NULL; ctx->state = B2TDecode; /*fall through*/ case B2TDecode: @@ -1777,7 +1779,7 @@ static void ttb_context_destructor(Binary *context_bin) context->alive = 0; switch (context->state) { case TTBSize: - DESTROY_SAVED_ESTACK(&context->s.sc.estack); + DESTROY_SAVED_WSTACK(&context->s.sc.wstack); break; case TTBEncode: DESTROY_SAVED_WSTACK(&context->s.ec.wstack); @@ -1845,7 +1847,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla /* Setup enough to get started */ context->state = TTBSize; context->alive = 1; - context->s.sc.estack.start = NULL; + context->s.sc.wstack.wstart = NULL; context->s.sc.flags = flags; context->s.sc.level = level; } else { @@ -2304,7 +2306,8 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_PATCH_FUN_SIZE ((Eterm) 2) #define ENC_BIN_COPY ((Eterm) 3) #define ENC_MAP_PAIR ((Eterm) 4) -#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 5) +#define ENC_HASHMAP_NODE ((Eterm) 5) +#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 6) static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, @@ -2413,6 +2416,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, WSTACK_PUSH2(s, ENC_TERM, *vptr); break; } + case ENC_HASHMAP_NODE: + if (is_list(obj)) { /* leaf node [K|V] */ + ptr = list_val(obj); + WSTACK_PUSH2(s, ENC_TERM, CDR(ptr)); + obj = CAR(ptr); + } + break; case ENC_LAST_ARRAY_ELEMENT: /* obj is the tuple */ { @@ -2594,23 +2604,54 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; case MAP_DEF: - { - map_t *mp = (map_t*)map_val(obj); - Uint size = map_get_size(mp); + if (is_flatmap(obj)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(obj); + Uint size = flatmap_get_size(mp); *ep++ = MAP_EXT; put_int32(size, ep); ep += 4; if (size > 0) { - Eterm *kptr = map_get_keys(mp); - Eterm *vptr = map_get_values(mp); + Eterm *kptr = flatmap_get_keys(mp); + Eterm *vptr = flatmap_get_values(mp); WSTACK_PUSH4(s, (UWord)kptr, (UWord)vptr, ENC_MAP_PAIR, size); } + } else { + Eterm hdr; + Uint node_sz; + ptr = boxed_val(obj); + hdr = *ptr; + ASSERT(is_header(hdr)); + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + *ep++ = MAP_EXT; + ptr++; + put_int32(*ptr, ep); ep += 4; + node_sz = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + *ep++ = MAP_EXT; + ptr++; + put_int32(*ptr, ep); ep += 4; + /*fall through*/ + case HAMT_SUBTAG_NODE_BITMAP: + node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(node_sz < 17); + break; + default: + erl_exit(1, "bad header\r\n"); + } + + ptr++; + WSTACK_RESERVE(s, node_sz*2); + while(node_sz--) { + WSTACK_FAST_PUSH(s, ENC_HASHMAP_NODE); + WSTACK_FAST_PUSH(s, *ptr++); + } } break; - case FLOAT_DEF: GET_DOUBLE(obj, f); if (dflags & DFLAG_NEW_FLOATS) { @@ -2892,9 +2933,19 @@ undo_offheap_in_area(ErlOffHeap* off_heap, Eterm* start, Eterm* end) #endif /* DEBUG */ } +struct dec_term_hamt_placeholder +{ + struct dec_term_hamt_placeholder* next; + Eterm* objp; /* write result here */ + Uint size; /* nr of leafs */ + Eterm leafs[1]; +}; + +#define DEC_TERM_HAMT_PLACEHOLDER_SIZE \ + (offsetof(struct dec_term_hamt_placeholder, leafs) / sizeof(Eterm)) /* Decode term from external format into *objp. -** On failure return NULL and (R13B04) *hpp will be unchanged. +** On failure return NULL and *hpp will be unchanged. */ static byte* dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, @@ -2904,7 +2955,8 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, int n; ErtsAtomEncoding char_enc; register Eterm* hp; /* Please don't take the address of hp */ - Eterm *maps_head; /* for validation of maps */ + Eterm *maps_list; /* for preprocessing of small maps */ + struct dec_term_hamt_placeholder* hamt_list; /* for preprocessing of big maps */ Eterm* next; SWord reds; @@ -2914,7 +2966,8 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, next = ctx->u.dc.next; ep = ctx->u.dc.ep; hpp = &ctx->u.dc.hp; - maps_head = ctx->u.dc.maps_head; + maps_list = ctx->u.dc.maps_list; + hamt_list = ctx->u.dc.hamt_list; if (ctx->state != B2TDecode) { int n_limit = reds; @@ -2995,7 +3048,8 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, reds = ERTS_SWORD_MAX; next = objp; *next = (Eterm) (UWord) NULL; - maps_head = NULL; + maps_list = NULL; + hamt_list = NULL; } hp = *hpp; @@ -3059,6 +3113,8 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, big = make_small(0); } else { big = bytes_to_big(first, n, neg, hp); + if (is_nil(big)) + goto error; if (is_big(big)) { hp += big_arity(big) + 1; } @@ -3397,6 +3453,7 @@ dec_term_atom_common: pb->size = n; pb->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*)pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); pb->val = dbin; pb->bytes = (byte*) dbin->orig_bytes; pb->flags = 0; @@ -3448,6 +3505,7 @@ dec_term_atom_common: pb->size = n; pb->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*)pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); pb->val = dbin; pb->bytes = (byte*) dbin->orig_bytes; pb->flags = 0; @@ -3529,46 +3587,67 @@ dec_term_atom_common: break; case MAP_EXT: { - map_t *mp; Uint32 size,n; Eterm *kptr,*vptr; Eterm keys; size = get_int32(ep); ep += 4; - keys = make_tuple(hp); - *hp++ = make_arityval(size); - hp += size; - kptr = hp - 1; - - mp = (map_t*)hp; - hp += MAP_HEADER_SIZE; - hp += size; - vptr = hp - 1; - - /* kptr, last word for keys - * vptr, last word for values - */ - - /* - * Use thing_word to link through decoded maps. - * The list of maps is for later validation. - */ - - mp->thing_word = (Eterm) COMPRESS_POINTER(maps_head); - maps_head = (Eterm *) mp; - - mp->size = size; - mp->keys = keys; - *objp = make_map(mp); - - for (n = size; n; n--) { - *vptr = (Eterm) COMPRESS_POINTER(next); - *kptr = (Eterm) COMPRESS_POINTER(vptr); - next = kptr; - vptr--; - kptr--; - } + if (size <= MAP_SMALL_MAP_LIMIT) { + flatmap_t *mp; + + keys = make_tuple(hp); + *hp++ = make_arityval(size); + hp += size; + kptr = hp - 1; + + mp = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + hp += size; + vptr = hp - 1; + + /* kptr, last word for keys + * vptr, last word for values + */ + + /* + * Use thing_word to link through decoded maps. + * The list of maps is for later validation. + */ + + mp->thing_word = (Eterm) COMPRESS_POINTER(maps_list); + maps_list = (Eterm *) mp; + + mp->size = size; + mp->keys = keys; + *objp = make_flatmap(mp); + + for (n = size; n; n--) { + *vptr = (Eterm) COMPRESS_POINTER(next); + *kptr = (Eterm) COMPRESS_POINTER(vptr); + next = kptr; + vptr--; + kptr--; + } + } + else { /* Make hamt */ + struct dec_term_hamt_placeholder* holder = + (struct dec_term_hamt_placeholder*) hp; + + holder->next = hamt_list; + hamt_list = holder; + holder->objp = objp; + holder->size = size; + + hp += DEC_TERM_HAMT_PLACEHOLDER_SIZE; + + for (n = size; n; n--) { + CDR(hp) = (Eterm) COMPRESS_POINTER(next); + CAR(hp) = (Eterm) COMPRESS_POINTER(&CDR(hp)); + next = &CAR(hp); + hp += 2; + } + } } break; case NEW_FUN_EXT: @@ -3746,6 +3825,7 @@ dec_term_atom_common: hp += PROC_BIN_SIZE; pb->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*)pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); pb->flags = 0; *objp = make_binary(pb); break; @@ -3763,6 +3843,7 @@ dec_term_atom_common: hp += PROC_BIN_SIZE; pb->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*)pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); pb->flags = 0; sub = (ErlSubBin*)hp; @@ -3789,7 +3870,8 @@ dec_term_atom_common: ctx->u.dc.ep = ep; ctx->u.dc.next = next; ctx->u.dc.hp = hp; - ctx->u.dc.maps_head = maps_head; + ctx->u.dc.maps_list = maps_list; + ctx->u.dc.hamt_list = hamt_list; ctx->reds = 0; return NULL; } @@ -3804,12 +3886,40 @@ dec_term_atom_common: * - done here for when we know it is complete. */ - while (maps_head) { - next = (Eterm *)(EXPAND_POINTER(*maps_head)); - *maps_head = MAP_HEADER; - if (!erts_validate_and_sort_map((map_t*)maps_head)) + while (maps_list) { + next = (Eterm *)(EXPAND_POINTER(*maps_list)); + *maps_list = MAP_HEADER_FLATMAP; + if (!erts_validate_and_sort_flatmap((flatmap_t*)maps_list)) goto error; - maps_head = next; + maps_list = next; + } + + /* Iterate through all the hamts and build tree nodes. + */ + if (hamt_list) { + ErtsHeapFactory factory; + + factory.p = NULL; + factory.hp = hp; + /* We assume heap will suffice (see hashmap_over_estimated_heap_size) */ + + do { + struct dec_term_hamt_placeholder* hamt = hamt_list; + *hamt->objp = erts_hashmap_from_array(&factory, + hamt->leafs, + hamt->size, + 1); + if (is_non_value(*hamt->objp)) + goto error; + + hamt_list = hamt->next; + + /* Yes, we waste a couple of heap words per hamt + for the temporary placeholder */ + *(Eterm*)hamt = make_pos_bignum_header(DEC_TERM_HAMT_PLACEHOLDER_SIZE-1); + } while (hamt_list); + + hp = factory.hp; } if (ctx) { @@ -3852,51 +3962,35 @@ static int encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags, Sint *reds, Uint *res) { - DECLARE_ESTACK(s); + DECLARE_WSTACK(s); Uint m, i, arity; Uint result = 0; Sint r = 0; if (ctx) { - ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); r = *reds; - if (ctx->estack.start) { /* restore saved stack */ - ESTACK_RESTORE(s, &ctx->estack); + if (ctx->wstack.wstart) { /* restore saved stack */ + WSTACK_RESTORE(s, &ctx->wstack); result = ctx->result; obj = ctx->obj; } } - goto L_jump_start; +#define LIST_TAIL_OP ((0 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER) +#define TERM_ARRAY_OP(N) (((N) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER) +#define TERM_ARRAY_OP_DEC(OP) ((OP) - (1 << _TAG_PRIMARY_SIZE)) + + + for (;;) { + ASSERT(!is_header(obj)); - outer_loop: - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - handle_popped_obj: - if (is_list(obj)) { - Eterm* cons = list_val(obj); - Eterm tl; - - tl = CDR(cons); - obj = CAR(cons); - ESTACK_PUSH(s, tl); - } else if (is_nil(obj)) { - result++; - goto outer_loop; - } else { - /* - * Other term (in the tail of a non-proper list or - * in a fun's environment). - */ - } - - L_jump_start: if (ctx && --r == 0) { *reds = r; ctx->obj = obj; ctx->result = result; - ESTACK_SAVE(s, &ctx->estack); + WSTACK_SAVE(s, &ctx->wstack); return -1; } switch (tag_val_def(obj)) { @@ -3979,70 +4073,79 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += m + 2 + 1; } else { result += 5; - goto handle_popped_obj; + WSTACK_PUSH2(s, (UWord)CDR(list_val(obj)), (UWord)LIST_TAIL_OP); + obj = CAR(list_val(obj)); + continue; /* big loop */ } break; case TUPLE_DEF: { Eterm* ptr = tuple_val(obj); - Uint i; arity = arityval(*ptr); if (arity <= 0xff) { result += 1 + 1; } else { result += 1 + 4; } - for (i = 1; i <= arity; ++i) { - if (is_list(ptr[i])) { - if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { - result += m + 2 + 1; - } else { - result += 5; - } - } - ESTACK_PUSH(s,ptr[i]); + if (arity > 1) { + WSTACK_PUSH2(s, (UWord) (ptr + 2), + (UWord) TERM_ARRAY_OP(arity-1)); } - goto outer_loop; + else if (arity == 0) { + break; + } + obj = ptr[1]; + continue; /* big loop */ } - break; case MAP_DEF: - { - map_t *mp = (map_t*)map_val(obj); - Uint size = map_get_size(mp); - Uint i; - Eterm *ptr; + if (is_flatmap(obj)) { + flatmap_t *mp = (flatmap_t*)flatmap_val(obj); + Uint size = flatmap_get_size(mp); result += 1 + 4; /* tag + 4 bytes size */ - /* push values first */ - ptr = map_get_values(mp); - i = size; - while(i--) { - if (is_list(*ptr)) { - if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) { - result += m + 2 + 1; - } else { - result += 5; - } - } - ESTACK_PUSH(s,*ptr); - ++ptr; + if (size) { + WSTACK_PUSH4(s, (UWord) flatmap_get_values(mp), + (UWord) TERM_ARRAY_OP(size), + (UWord) flatmap_get_keys(mp), + (UWord) TERM_ARRAY_OP(size)); + } + } else { + Eterm *ptr; + Eterm hdr; + Uint node_sz; + ptr = boxed_val(obj); + hdr = *ptr; + ASSERT(is_header(hdr)); + switch(hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + ptr++; + node_sz = 16; + result += 1 + 4; /* tag + 4 bytes size */ + break; + case HAMT_SUBTAG_HEAD_BITMAP: + ptr++; + result += 1 + 4; /* tag + 4 bytes size */ + /*fall through*/ + case HAMT_SUBTAG_NODE_BITMAP: + node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(node_sz < 17); + break; + default: + erl_exit(1, "bad header\r\n"); } - ptr = map_get_keys(mp); - i = size; - while(i--) { - if (is_list(*ptr)) { - if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) { - result += m + 2 + 1; - } else { - result += 5; - } + ptr++; + WSTACK_RESERVE(s, node_sz*2); + while(node_sz--) { + if (is_list(*ptr)) { + WSTACK_FAST_PUSH(s, CAR(list_val(*ptr))); + WSTACK_FAST_PUSH(s, CDR(list_val(*ptr))); + } else { + WSTACK_FAST_PUSH(s, *ptr); } - ESTACK_PUSH(s,*ptr); - ++ptr; + ptr++; } - goto outer_loop; } break; case FLOAT_DEF: @@ -4095,25 +4198,13 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += 2 * (1 + 4); /* Index + Uniq */ result += 1 + (funp->num_free < 0x100 ? 1 : 4); } - for (i = 1; i < funp->num_free; i++) { - obj = funp->env[i]; - - if (is_not_list(obj)) { - /* Push any non-list terms on the stack */ - ESTACK_PUSH(s, obj); - } else { - /* Lists must be handled specially. */ - if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { - result += m + 2 + 1; - } else { - result += 5; - ESTACK_PUSH(s, obj); - } - } + if (funp->num_free > 1) { + WSTACK_PUSH2(s, (UWord) (funp->env + 1), + (UWord) TERM_ARRAY_OP(funp->num_free-1)); } if (funp->num_free != 0) { obj = funp->env[0]; - goto L_jump_start; + continue; /* big loop */ } break; } @@ -4136,17 +4227,48 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, erl_exit(1,"Internal data structure error (in encode_size_struct2)%x\n", obj); } + + if (WSTACK_ISEMPTY(s)) { + break; + } + obj = (Eterm) WSTACK_POP(s); + + if (is_header(obj)) { + switch (obj) { + case LIST_TAIL_OP: + obj = (Eterm) WSTACK_POP(s); + if (is_list(obj)) { + Eterm* cons = list_val(obj); + + WSTACK_PUSH2(s, (UWord)CDR(cons), (UWord)LIST_TAIL_OP); + obj = CAR(cons); + } + break; + + case TERM_ARRAY_OP(1): + obj = *(Eterm*)WSTACK_POP(s); + break; + default: { /* TERM_ARRAY_OP(N) when N > 1 */ + Eterm* ptr = (Eterm*) WSTACK_POP(s); + WSTACK_PUSH2(s, (UWord) (ptr+1), + (UWord) TERM_ARRAY_OP_DEC(obj)); + obj = *ptr; + } + } + } } - DESTROY_ESTACK(s); + WSTACK_DESTROY(s); if (ctx) { - ASSERT(ctx->estack.start == NULL); + ASSERT(ctx->wstack.wstart == NULL); *reds = r; } *res = result; return 0; } + + static Sint decoded_size(byte *ep, byte* endp, int internal_tags, B2TContext* ctx) { @@ -4340,7 +4462,11 @@ init_done: n = get_int32(ep); ep += 4; ADDTERMS(2*n); - heap_size += 3 + n + 1 + n; + if (n <= MAP_SMALL_MAP_LIMIT) { + heap_size += 3 + n + 1 + n; + } else { + heap_size += hashmap_over_estimated_heap_size(n); + } break; case STRING_EXT: CHKSIZE(2); diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index f120e96e3b..50fcfa04d6 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -157,7 +157,6 @@ void erts_init_atom_cache_map(ErtsAtomCacheMap *); void erts_reset_atom_cache_map(ErtsAtomCacheMap *); void erts_destroy_atom_cache_map(ErtsAtomCacheMap *); void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32); -Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 5330f389e0..340c7033ab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -52,6 +52,7 @@ struct enif_environment_t /* ErlNifEnv */ ErlHeapFragment* heap_frag; int fpe_was_unmasked; struct enif_tmp_obj_t* tmp_obj_list; + int exception_thrown; /* boolean */ }; extern void erts_pre_nif(struct enif_environment_t*, Process*, struct erl_module_nif*); @@ -348,8 +349,6 @@ extern Uint display_items; /* no of items to display in traces etc */ extern int erts_backtrace_depth; extern erts_smp_atomic32_t erts_max_gen_gcs; -extern int erts_disable_tolerant_timeofday; - extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */ extern int stackdump_on_exit; @@ -372,16 +371,17 @@ extern int stackdump_on_exit; * DESTROY_ESTACK(Stack) */ -typedef struct { +typedef struct ErtsEStack_ { Eterm* start; Eterm* sp; Eterm* end; + Eterm* edefault; ErtsAlcType_t alloc_type; }ErtsEStack; #define DEF_ESTACK_SIZE (16) -void erl_grow_estack(ErtsEStack*, Eterm* def_stack); +void erl_grow_estack(ErtsEStack*, Uint need); #define ESTK_CONCAT(a,b) a##b #define ESTK_DEF_STACK(s) ESTK_CONCAT(s,_default_estack) @@ -391,22 +391,23 @@ void erl_grow_estack(ErtsEStack*, Eterm* def_stack); ESTK_DEF_STACK(s), /* start */ \ ESTK_DEF_STACK(s), /* sp */ \ ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \ + ESTK_DEF_STACK(s), /* default */ \ ERTS_ALC_T_ESTACK /* alloc_type */ \ } #define ESTACK_CHANGE_ALLOCATOR(s,t) \ do { \ - if (s.start != ESTK_DEF_STACK(s)) { \ + if ((s).start != ESTK_DEF_STACK(s)) { \ erl_exit(1, "Internal error - trying to change allocator " \ "type of active estack\n"); \ } \ - s.alloc_type = (t); \ + (s).alloc_type = (t); \ } while (0) #define DESTROY_ESTACK(s) \ do { \ - if (s.start != ESTK_DEF_STACK(s)) { \ - erts_free(s.alloc_type, s.start); \ + if ((s).start != ESTK_DEF_STACK(s)) { \ + erts_free((s).alloc_type, (s).start); \ } \ } while(0) @@ -417,16 +418,17 @@ do { \ */ #define ESTACK_SAVE(s,dst)\ do {\ - if (s.start == ESTK_DEF_STACK(s)) {\ + if ((s).start == ESTK_DEF_STACK(s)) {\ UWord _wsz = ESTACK_COUNT(s);\ - (dst)->start = erts_alloc(s.alloc_type,\ + (dst)->start = erts_alloc((s).alloc_type,\ DEF_ESTACK_SIZE * sizeof(Eterm));\ - memcpy((dst)->start, s.start,_wsz*sizeof(Eterm));\ + memcpy((dst)->start, (s).start,_wsz*sizeof(Eterm));\ (dst)->sp = (dst)->start + _wsz;\ (dst)->end = (dst)->start + DEF_ESTACK_SIZE;\ - (dst)->alloc_type = s.alloc_type;\ + (dst)->edefault = NULL;\ + (dst)->alloc_type = (s).alloc_type;\ } else\ - *(dst) = s;\ + *(dst) = (s);\ } while (0) #define DESTROY_SAVED_ESTACK(estack)\ @@ -445,83 +447,114 @@ do {\ */ #define ESTACK_RESTORE(s, src) \ do { \ - ASSERT(s.start == ESTK_DEF_STACK(s)); \ - s = *(src); /* struct copy */ \ + ASSERT((s).start == ESTK_DEF_STACK(s)); \ + (s) = *(src); /* struct copy */ \ (src)->start = NULL; \ - ASSERT(s.sp >= s.start); \ - ASSERT(s.sp <= s.end); \ + ASSERT((s).sp >= (s).start); \ + ASSERT((s).sp <= (s).end); \ } while (0) -#define ESTACK_IS_STATIC(s) (s.start == ESTK_DEF_STACK(s))) +#define ESTACK_IS_STATIC(s) ((s).start == ESTK_DEF_STACK(s)) -#define ESTACK_PUSH(s, x) \ -do { \ - if (s.sp == s.end) { \ - erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ - } \ - *s.sp++ = (x); \ +#define ESTACK_PUSH(s, x) \ +do { \ + if ((s).sp == (s).end) { \ + erl_grow_estack(&(s), 1); \ + } \ + *(s).sp++ = (x); \ } while(0) #define ESTACK_PUSH2(s, x, y) \ do { \ - if (s.sp > s.end - 2) { \ - erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + if ((s).sp > (s).end - 2) { \ + erl_grow_estack(&(s), 2); \ } \ - *s.sp++ = (x); \ - *s.sp++ = (y); \ + *(s).sp++ = (x); \ + *(s).sp++ = (y); \ } while(0) #define ESTACK_PUSH3(s, x, y, z) \ do { \ - if (s.sp > s.end - 3) { \ - erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + if ((s).sp > (s).end - 3) { \ + erl_grow_estack(&s, 3); \ } \ - *s.sp++ = (x); \ - *s.sp++ = (y); \ - *s.sp++ = (z); \ + *(s).sp++ = (x); \ + *(s).sp++ = (y); \ + *(s).sp++ = (z); \ } while(0) #define ESTACK_PUSH4(s, E1, E2, E3, E4) \ do { \ - if (s.sp > s.end - 4) { \ - erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + if ((s).sp > (s).end - 4) { \ + erl_grow_estack(&s, 4); \ } \ - *s.sp++ = (E1); \ - *s.sp++ = (E2); \ - *s.sp++ = (E3); \ - *s.sp++ = (E4); \ + *(s).sp++ = (E1); \ + *(s).sp++ = (E2); \ + *(s).sp++ = (E3); \ + *(s).sp++ = (E4); \ } while(0) -#define ESTACK_COUNT(s) (s.sp - s.start) -#define ESTACK_ISEMPTY(s) (s.sp == s.start) -#define ESTACK_POP(s) (*(--s.sp)) +#define ESTACK_RESERVE(s, push_cnt) \ +do { \ + if ((s).sp > (s).end - (push_cnt)) { \ + erl_grow_estack(&(s), (push_cnt)); \ + } \ +} while(0) + +/* Must be preceded by ESTACK_RESERVE */ +#define ESTACK_FAST_PUSH(s, x) \ +do { \ + ASSERT((s).sp < (s).end); \ + *s.sp++ = (x); \ +} while(0) + +#define ESTACK_COUNT(s) ((s).sp - (s).start) +#define ESTACK_ISEMPTY(s) ((s).sp == (s).start) +#define ESTACK_POP(s) (*(--(s).sp)) /* * WSTACK: same as ESTACK but with UWord instead of Eterm */ -typedef struct { +typedef struct ErtsWStack_ { UWord* wstart; UWord* wsp; UWord* wend; + UWord* wdefault; ErtsAlcType_t alloc_type; }ErtsWStack; #define DEF_WSTACK_SIZE (16) -void erl_grow_wstack(ErtsWStack*, UWord* def_stack); +void erl_grow_wstack(ErtsWStack*, Uint need); #define WSTK_CONCAT(a,b) a##b #define WSTK_DEF_STACK(s) WSTK_CONCAT(s,_default_wstack) -#define DECLARE_WSTACK(s) \ +#define WSTACK_DECLARE(s) \ UWord WSTK_DEF_STACK(s)[DEF_WSTACK_SIZE]; \ ErtsWStack s = { \ WSTK_DEF_STACK(s), /* wstart */ \ WSTK_DEF_STACK(s), /* wsp */ \ WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \ + WSTK_DEF_STACK(s), /* wdflt */ \ ERTS_ALC_T_ESTACK /* alloc_type */ \ } +#define DECLARE_WSTACK WSTACK_DECLARE + +typedef struct ErtsDynamicWStack_ { + UWord default_stack[DEF_WSTACK_SIZE]; + ErtsWStack ws; +}ErtsDynamicWStack; + +#define WSTACK_INIT(dwsp, ALC_TYPE) \ +do { \ + (dwsp)->ws.wstart = (dwsp)->default_stack; \ + (dwsp)->ws.wsp = (dwsp)->default_stack; \ + (dwsp)->ws.wend = (dwsp)->default_stack + DEF_WSTACK_SIZE;\ + (dwsp)->ws.wdefault = (dwsp)->default_stack; \ + (dwsp)->ws.alloc_type = ALC_TYPE; \ +} while (0) #define WSTACK_CHANGE_ALLOCATOR(s,t) \ do { \ @@ -532,13 +565,20 @@ do { \ s.alloc_type = (t); \ } while (0) -#define DESTROY_WSTACK(s) \ +#define WSTACK_DESTROY(s) \ do { \ - if (s.wstart != WSTK_DEF_STACK(s)) { \ + if (s.wstart != s.wdefault) { \ erts_free(s.alloc_type, s.wstart); \ } \ } while(0) +#define DESTROY_WSTACK WSTACK_DESTROY +#define WSTACK_DEBUG(s) \ + do { \ + fprintf(stderr, "wstack size = %ld\r\n", s.wsp - s.wstart); \ + fprintf(stderr, "wstack wstart = %p\r\n", s.wstart); \ + fprintf(stderr, "wstack wsp = %p\r\n", s.wsp); \ + } while(0) /* * Do not free the stack after this, it may have pointers into what @@ -553,6 +593,7 @@ do {\ memcpy((dst)->wstart, s.wstart,_wsz*sizeof(UWord));\ (dst)->wsp = (dst)->wstart + _wsz;\ (dst)->wend = (dst)->wstart + DEF_WSTACK_SIZE;\ + (dst)->wdefault = NULL;\ (dst)->alloc_type = s.alloc_type;\ } else\ *(dst) = s;\ @@ -581,12 +622,12 @@ do { \ ASSERT(s.wsp <= s.wend); \ } while (0) -#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s))) +#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s)) #define WSTACK_PUSH(s, x) \ do { \ if (s.wsp == s.wend) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + erl_grow_wstack(&s, 1); \ } \ *s.wsp++ = (x); \ } while(0) @@ -594,7 +635,7 @@ do { \ #define WSTACK_PUSH2(s, x, y) \ do { \ if (s.wsp > s.wend - 2) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + erl_grow_wstack(&s, 2); \ } \ *s.wsp++ = (x); \ *s.wsp++ = (y); \ @@ -602,8 +643,8 @@ do { \ #define WSTACK_PUSH3(s, x, y, z) \ do { \ - if (s.wsp > s.wend - 3) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + if (s.wsp > s.wend - 3) { \ + erl_grow_wstack(&s, 3); \ } \ *s.wsp++ = (x); \ *s.wsp++ = (y); \ @@ -612,8 +653,8 @@ do { \ #define WSTACK_PUSH4(s, A1, A2, A3, A4) \ do { \ - if (s.wsp > s.wend - 4) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + if (s.wsp > s.wend - 4) { \ + erl_grow_wstack(&s, 4); \ } \ *s.wsp++ = (A1); \ *s.wsp++ = (A2); \ @@ -624,7 +665,7 @@ do { \ #define WSTACK_PUSH5(s, A1, A2, A3, A4, A5) \ do { \ if (s.wsp > s.wend - 5) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + erl_grow_wstack(&s, 5); \ } \ *s.wsp++ = (A1); \ *s.wsp++ = (A2); \ @@ -636,7 +677,7 @@ do { \ #define WSTACK_PUSH6(s, A1, A2, A3, A4, A5, A6) \ do { \ if (s.wsp > s.wend - 6) { \ - erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + erl_grow_wstack(&s, 6); \ } \ *s.wsp++ = (A1); \ *s.wsp++ = (A2); \ @@ -646,9 +687,85 @@ do { \ *s.wsp++ = (A6); \ } while(0) +#define WSTACK_RESERVE(s, push_cnt) \ +do { \ + if (s.wsp > s.wend - (push_cnt)) { \ + erl_grow_wstack(&s, (push_cnt)); \ + } \ +} while(0) + +/* Must be preceded by WSTACK_RESERVE */ +#define WSTACK_FAST_PUSH(s, x) \ +do { \ + ASSERT(s.wsp < s.wend); \ + *s.wsp++ = (x); \ +} while(0) + #define WSTACK_COUNT(s) (s.wsp - s.wstart) #define WSTACK_ISEMPTY(s) (s.wsp == s.wstart) -#define WSTACK_POP(s) (*(--s.wsp)) +#define WSTACK_POP(s) ((ASSERT(s.wsp > s.wstart)),*(--s.wsp)) + +#define WSTACK_ROLLBACK(s, count) (ASSERT(WSTACK_COUNT(s) >= (count)), \ + s.wsp = s.wstart + (count)) + +/* PSTACK - Stack of any type. + * Usage: + * { + * #define PSTACK_TYPE MyType + * PSTACK_DECLARE(s,16); + * MyType *sp = PSTACK_PUSH(s); + * + * sp->x = .... + * sp->y = .... + * sp = PSTACK_PUSH(s); + * ... + * sp = PSTACK_POP(s); + * if (PSTACK_IS_EMPTY(s)) { + * // sp is invalid when stack is empty after pop + * } + * + * PSTACK_DESTROY(s); + * } + */ + + +typedef struct ErtsPStack_ { + byte* pstart; + byte* psp; + byte* pend; + ErtsAlcType_t alloc_type; +}ErtsPStack; + +void erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes); +#define PSTK_CONCAT(a,b) a##b +#define PSTK_DEF_STACK(s) PSTK_CONCAT(s,_default_pstack) + +#define PSTACK_DECLARE(s, DEF_PSTACK_SIZE) \ +PSTACK_TYPE PSTK_DEF_STACK(s)[DEF_PSTACK_SIZE]; \ +ErtsPStack s = { (byte*)PSTK_DEF_STACK(s), /* pstart */ \ + (byte*)(PSTK_DEF_STACK(s) - 1), /* psp */ \ + (byte*)(PSTK_DEF_STACK(s) + (DEF_PSTACK_SIZE)), /* pend */\ + ERTS_ALC_T_ESTACK /* alloc_type */ \ +} + +#define PSTACK_DESTROY(s) \ +do { \ + if (s.pstart != (byte*)PSTK_DEF_STACK(s)) { \ + erts_free(s.alloc_type, s.pstart); \ + } \ +} while(0) + +#define PSTACK_IS_EMPTY(s) (s.psp < s.pstart) + +#define PSTACK_TOP(s) (ASSERT(!PSTACK_IS_EMPTY(s)), (PSTACK_TYPE*)(s.psp)) + +#define PSTACK_PUSH(s) \ + (s.psp += sizeof(PSTACK_TYPE), \ + ((s.psp == s.pend) ? erl_grow_pstack(&s, PSTK_DEF_STACK(s), \ + sizeof(PSTACK_TYPE)) : (void)0), \ + ((PSTACK_TYPE*) s.psp)) + +#define PSTACK_POP(s) ((PSTACK_TYPE*) (s.psp -= sizeof(PSTACK_TYPE))) /* binary.c */ @@ -671,9 +788,6 @@ erts_bld_port_info(Eterm **hpp, void erts_bif_info_init(void); /* bif.c */ -Eterm erts_make_ref(Process *); -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]); -void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); ERTS_GLB_INLINE Eterm erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]); @@ -753,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*, ...); @@ -1192,7 +1309,8 @@ erts_alloc_message_heap_state(Uint size, state = erts_smp_atomic32_read_acqb(&receiver->state); if (statep) *statep = state; - if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + if (state & (ERTS_PSFLG_EXITING + | ERTS_PSFLG_PENDING_EXIT)) goto allocate_in_mbuf; #endif @@ -1212,7 +1330,8 @@ erts_alloc_message_heap_state(Uint size, state = erts_smp_atomic32_read_nob(&receiver->state); if (statep) *statep = state; - if ((state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + 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 dc4c6fc350..ccc7da265e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -47,6 +47,8 @@ #include "external.h" #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__ @@ -378,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; @@ -462,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); @@ -735,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, @@ -1429,15 +1419,7 @@ queue_port_sched_op_reply(Process *rp, bp = erts_resize_message_buffer(bp, used_h_size, &msg, 1); } - erts_queue_message(rp, - rp_locksp, - bp, - msg, - NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, rp_locksp, bp, msg, NIL); } static void @@ -2805,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); @@ -3072,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; @@ -3085,16 +3068,12 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks); res = copy_struct(res, sz_res, &hp, ohp); tuple = TUPLE2(hp, sender, res); - erts_queue_message(rp, &rp_locks, bp, tuple, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, tuple, NIL); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } } @@ -3138,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; @@ -3185,15 +3164,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) - erts_smp_proc_dec_refc(rp); + erts_proc_dec_refc(rp); } /* @@ -3279,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; @@ -3356,14 +3331,10 @@ deliver_vec_message(Port* prt, /* Port */ tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + 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); } @@ -3453,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)) { @@ -4085,6 +4053,9 @@ erts_port_control(Process* c_p, size, &resp_bufp, &resp_size); + + control_flags = prt->control_flags; + finalize_imm_drv_call(&try_call_state); if (tmp_alloced) erts_free(ERTS_ALC_T_TMP, bufp); @@ -4092,8 +4063,6 @@ erts_port_control(Process* c_p, return ERTS_PORT_OP_BADARG; } - control_flags = prt->control_flags; - hsz = port_control_result_size(control_flags, resp_bufp, &resp_size, @@ -4482,7 +4451,7 @@ make_port_info_term(Eterm **hpp_start, int len; int start; static Eterm item[] = ERTS_PORT_INFO_1_ITEMS; - static Eterm value[sizeof(item)/sizeof(item[0])]; + Eterm value[sizeof(item)/sizeof(item[0])]; start = 0; len = sizeof(item)/sizeof(item[0]); @@ -5003,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; @@ -5049,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; @@ -5059,15 +5010,11 @@ void driver_report_exit(ErlDrvPort ix, int status) hp += 3; tuple = TUPLE2(hp, prt->common.id, tuple); - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + 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); } #define ERTS_B2T_STATES_DEF_STATES_SZ 5 @@ -5349,7 +5296,11 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) case ERL_DRV_MAP: { /* int */ ERTS_DDT_CHK_ENOUGH_ARGS(1); if ((int) ptr[0] < 0) ERTS_DDT_FAIL; - need += MAP_HEADER_SIZE + 1 + 2*ptr[0]; + if (ptr[0] > MAP_SMALL_MAP_LIMIT) { + need += hashmap_over_estimated_heap_size(ptr[0]); + } else { + need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0]; + } depth -= 2*ptr[0]; if (depth < 0) ERTS_DDT_FAIL; ptr++; @@ -5379,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; @@ -5577,7 +5528,9 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) mess = make_float(hp); f.fd = *((double *) ptr[0]); - PUT_DOUBLE(f, hp); + if (!erts_isfinite(f.fd)) + ERTS_DDT_FAIL; + PUT_DOUBLE(f, hp); hp += FLOAT_SIZE_OBJECT; ptr++; break; @@ -5593,31 +5546,52 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) case ERL_DRV_MAP: { /* int */ int size = (int)ptr[0]; - Eterm* tp = hp; - Eterm* vp; - map_t *mp; - - *tp = make_arityval(size); - - hp += 1 + size; - mp = (map_t*)hp; - mp->thing_word = MAP_HEADER; - mp->size = size; - mp->keys = make_tuple(tp); - mess = make_map(mp); - - hp += MAP_HEADER_SIZE + size; /* advance "heap" pointer */ - - tp += size; /* point at last key */ - vp = hp - 1; /* point at last value */ - - while(size--) { - *vp-- = ESTACK_POP(stack); - *tp-- = ESTACK_POP(stack); - } - if (!erts_validate_and_sort_map(mp)) - ERTS_DDT_FAIL; - ptr++; + if (size > MAP_SMALL_MAP_LIMIT) { + int ix = 2*size; + ErtsHeapFactory factory; + Eterm* leafs = hp; + + hp += 2*size; + while(ix--) { *--hp = ESTACK_POP(stack); } + + hp += 2*size; + factory.p = NULL; + factory.hp = hp; + /* We assume heap will suffice (see hashmap_over_estimated_heap_size) */ + + mess = erts_hashmap_from_array(&factory, leafs, size, 1); + + if (is_non_value(mess)) + ERTS_DDT_FAIL; + + hp = factory.hp; + } else { + Eterm* tp = hp; + Eterm* vp; + flatmap_t *mp; + + *tp = make_arityval(size); + + hp += 1 + size; + mp = (flatmap_t*)hp; + mp->thing_word = MAP_HEADER_FLATMAP; + mp->size = size; + mp->keys = make_tuple(tp); + mess = make_flatmap(mp); + + hp += MAP_HEADER_FLATMAP_SZ + size; + + tp += size; /* point at last key */ + vp = hp - 1; /* point at last value */ + + while(size--) { + *vp-- = ESTACK_POP(stack); + *tp-- = ESTACK_POP(stack); + } + if (!erts_validate_and_sort_flatmap(mp)) + ERTS_DDT_FAIL; + } + ptr++; break; } @@ -5638,11 +5612,7 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) HRelease(rp, hp_end, hp); } /* send message */ - erts_queue_message(rp, &rp_locks, bp, mess, am_undefined -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(rp, &rp_locks, bp, mess, am_undefined); } else { if (b2t.ix > b2t.used) @@ -5655,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; @@ -6608,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); @@ -6631,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; } @@ -6653,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 68fcc177ae..ece038131e 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -166,22 +166,26 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -i_select_val r f I -i_select_val x f I -i_select_val y f I +i_select_val_bins r f I +i_select_val_bins x f I +i_select_val_bins y f I -i_select_val2 r f c f c f -i_select_val2 x f c f c f -i_select_val2 y f c f c f +i_select_val_lins r f I +i_select_val_lins x f I +i_select_val_lins y f I -i_select_tuple_arity2 r f A f A f -i_select_tuple_arity2 x f A f A f -i_select_tuple_arity2 y f A f A f +i_select_val2 r f c c f f +i_select_val2 x f c c f f +i_select_val2 y f c c f f i_select_tuple_arity r f I i_select_tuple_arity x f I i_select_tuple_arity y f I +i_select_tuple_arity2 r f A A f f +i_select_tuple_arity2 x f A A f f +i_select_tuple_arity2 y f A A f f + i_jump_on_val_zero r f I i_jump_on_val_zero x f I i_jump_on_val_zero y f I @@ -294,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 @@ -309,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 @@ -388,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 @@ -489,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 @@ -506,6 +607,7 @@ i_fetch y x i_fetch y y %cold +i_fetch c c i_fetch s s %hot @@ -1469,79 +1571,67 @@ apply_last I P # Map instructions in R17. # -put_map_assoc F n Dst Live Size Rest=* => new_map F Dst Live Size Rest -put_map_assoc F Src=s Dst Live Size Rest=* => \ +sorted_put_map_assoc/5 +put_map_assoc F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ + sorted_put_map_assoc F Map Dst Live Size Rest + +sorted_put_map_exact/5 +put_map_exact F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ + sorted_put_map_exact F Map Dst Live Size Rest + +sorted_put_map_assoc j Map Dst Live Size Rest=* | is_empty_map(Map) => \ + new_map Dst Live Size Rest +sorted_put_map_assoc F Src=s Dst Live Size Rest=* => \ update_map_assoc F Src Dst Live Size Rest -put_map_assoc F Src Dst Live Size Rest=* => \ +sorted_put_map_assoc F Src Dst Live Size Rest=* => \ move Src x | update_map_assoc F x Dst Live Size Rest -put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest -put_map_exact F Src=s Dst Live Size Rest=* => \ + +sorted_put_map_exact F Src=s Dst Live Size Rest=* => \ update_map_exact F Src Dst Live Size Rest -put_map_exact F Src Dst Live Size Rest=* => \ +sorted_put_map_exact F Src Dst Live Size Rest=* => \ move Src x | update_map_exact F x Dst Live Size Rest -new_map j d I I +new_map d I I update_map_assoc j s d I I update_map_exact j s d I I -is_map Fail Literal=q => move Literal x | is_map Fail x -is_map Fail c => jump Fail +is_map Fail Lit=q | literal_is_map(Lit) => +is_map Fail cq => jump Fail %macro: is_map IsMap -fail_action is_map f r is_map f x is_map f y -## Transform has_map_field(s) #{ K1 := _, K2 := _ } +## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements -has_map_field/3 - -has_map_fields Fail Src Size=u==1 Rest=* => gen_has_map_field(Fail,Src,Size,Rest) -has_map_fields Fail Src Size Rest=* => i_has_map_fields Fail Src Size Rest - -i_has_map_fields f s I - -has_map_field Fail Src=rxy Key=arxy => i_has_map_field Fail Src Key -has_map_field Fail Src Key => move Key x | i_has_map_field Fail Src x - -%macro: i_has_map_field HasMapField -fail_action -i_has_map_field f r a -i_has_map_field f x a -i_has_map_field f y a -i_has_map_field f r r -i_has_map_field f x r -i_has_map_field f y r -i_has_map_field f r x -i_has_map_field f x x -i_has_map_field f y x -i_has_map_field f r y -i_has_map_field f x y -i_has_map_field f y y +has_map_fields Fail Src Size Rest=* => \ + gen_has_map_fields(Fail, Src, Size, Rest) ## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 } -get_map_element/4 - -get_map_elements Fail Src=rxy Size=u==2 Rest=* => gen_get_map_element(Fail,Src,Size,Rest) -get_map_elements Fail Src Size Rest=* => i_get_map_elements Fail Src Size Rest +get_map_elements Fail Src=rxy Size=u==2 Rest=* => \ + gen_get_map_element(Fail, Src, Size, Rest) +get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ + gen_get_map_elements(Fail, Src, Size, Rest) i_get_map_elements f s I -get_map_element Fail Src=rxy Key=ax Dst => i_get_map_element Fail Src Key Dst -get_map_element Fail Src=rxy Key=rycq Dst => \ +i_get_map_element Fail Src=rxy Key=ry Dst => \ move Key x | i_get_map_element Fail Src x Dst -get_map_element Fail Src Key Dst => jump Fail + +%macro: i_get_map_element_hash GetMapElementHash -fail_action +i_get_map_element_hash f r c I r +i_get_map_element_hash f x c I r +i_get_map_element_hash f y c I r +i_get_map_element_hash f r c I x +i_get_map_element_hash f x c I x +i_get_map_element_hash f y c I x +i_get_map_element_hash f r c I y +i_get_map_element_hash f x c I y +i_get_map_element_hash f y c I y %macro: i_get_map_element GetMapElement -fail_action -i_get_map_element f r a r -i_get_map_element f x a r -i_get_map_element f y a r -i_get_map_element f r a x -i_get_map_element f x a x -i_get_map_element f y a x -i_get_map_element f r a y -i_get_map_element f x a y -i_get_map_element f y a y i_get_map_element f r x r i_get_map_element f x x r i_get_map_element f y x r @@ -1570,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 @@ -1594,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 828f5b427a..54059ee9a5 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -21,6 +21,25 @@ #define __SYS_H__ +#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) +# undef ERTS_CAN_INLINE +# define ERTS_CAN_INLINE 0 +# undef ERTS_INLINE +# define ERTS_INLINE +#endif + +#if ERTS_CAN_INLINE +#define ERTS_GLB_INLINE static ERTS_INLINE +#else +#define ERTS_GLB_INLINE +#endif + +#if ERTS_CAN_INLINE || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) +# define ERTS_GLB_INLINE_INCL_FUNC_DEF 1 +#else +# define ERTS_GLB_INLINE_INCL_FUNC_DEF 0 +#endif + #if defined(VALGRIND) && !defined(NO_FPE_SIGNALS) # define NO_FPE_SIGNALS #endif @@ -132,24 +151,8 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; # endif #endif -#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) -# undef ERTS_CAN_INLINE -# define ERTS_CAN_INLINE 0 -# undef ERTS_INLINE -# define ERTS_INLINE -#endif - -#if ERTS_CAN_INLINE -#define ERTS_GLB_INLINE static ERTS_INLINE -#else -#define ERTS_GLB_INLINE -#endif - -#if ERTS_CAN_INLINE || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) -# define ERTS_GLB_INLINE_INCL_FUNC_DEF 1 -#else -# define ERTS_GLB_INLINE_INCL_FUNC_DEF 0 -#endif +#define ERTS_MK_VSN_INT(Major, Minor, Build) \ + ((((Major) & 0x3ff) << 20) | (((Minor) & 0x3ff) << 10) | ((Build) & 0x3ff)) #ifndef ERTS_EXIT_AFTER_DUMP # define ERTS_EXIT_AFTER_DUMP exit @@ -188,6 +191,16 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f # define ASSERT(e) ((void) 1) #endif +/* ERTS_UNDEF can be used to silence false warnings about + * "variable may be used uninitialized" while keeping the variable + * marked as undefined by valgrind. + */ +#ifdef VALGRIND +# define ERTS_UNDEF(V,I) +#else +# define ERTS_UNDEF(V,I) V = I +#endif + /* * Compile time assert * (the actual compiler error msg can be a bit confusing) @@ -375,17 +388,45 @@ typedef Sint SWord; typedef UWord BeamInstr; #ifndef HAVE_INT64 -#if SIZEOF_LONG == 8 -#define HAVE_INT64 1 +# if SIZEOF_LONG == 8 +# define HAVE_INT64 1 typedef unsigned long Uint64; typedef long Sint64; -#elif SIZEOF_LONG_LONG == 8 -#define HAVE_INT64 1 +# ifdef ULONG_MAX +# define ERTS_UINT64_MAX ULONG_MAX +# endif +# ifdef LONG_MAX +# define ERTS_SINT64_MAX LONG_MAX +# endif +# ifdef LONG_MIN +# define ERTS_SINT64_MIN LONG_MIN +# endif +# elif SIZEOF_LONG_LONG == 8 +# define HAVE_INT64 1 typedef unsigned long long Uint64; typedef long long Sint64; -#else -#define HAVE_INT64 0 +# ifdef ULLONG_MAX +# define ERTS_UINT64_MAX ULLONG_MAX +# endif +# ifdef LLONG_MAX +# define ERTS_SINT64_MAX LLONG_MAX +# endif +# ifdef LLONG_MIN +# define ERTS_SINT64_MIN LLONG_MIN +# endif +# else +# error "No 64-bit integer type found" +# endif +#endif + +#ifndef ERTS_UINT64_MAX +# define ERTS_UINT64_MAX (~((Uint64) 0)) +#endif +#ifndef ERTS_SINT64_MAX +# define ERTS_SINT64_MAX ((Sint64) ((((Uint64) 1) << 63)-1)) #endif +#ifndef ERTS_SINT64_MIN +# define ERTS_SINT64_MIN (-1*(((Sint64) 1) << 63)) #endif #if SIZEOF_LONG == 4 @@ -662,14 +703,37 @@ extern char *erts_default_arg0; extern char os_type[]; -extern int sys_init_time(void); +typedef struct { + int have_os_monotonic_time; + int have_corrected_os_monotonic_time; + ErtsMonotonicTime os_monotonic_time_unit; + ErtsMonotonicTime sys_clock_resolution; + struct { + Uint64 resolution; + char *func; + char *clock_id; + int locked_use; + int extended; + } os_monotonic_time_info; + struct { + Uint64 resolution; + char *func; + char *clock_id; + int locked_use; + } os_system_time_info; +} ErtsSysInitTimeResult; + +#define ERTS_SYS_INIT_TIME_RESULT_INITER \ + {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(void); extern void erts_sys_init_float(void); extern void erts_thread_init_float(void); extern void erts_thread_disable_fpe(void); - ERTS_GLB_INLINE int erts_block_fpe(void); ERTS_GLB_INLINE void erts_unblock_fpe(int); @@ -712,11 +776,9 @@ 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 set, erts_short_time_t msec); +void erts_sys_schedule_interrupt_timed(int, ErtsMonotonicTime); void erts_sys_main_thread(void); #endif @@ -755,6 +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*); +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 2fd8e0cf00..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,26 +88,25 @@ #define ASSERT_NO_LOCKED_LOCKS #endif -static erts_smp_mtx_t tiw_lock; - - -/* BEGIN tiw_lock protected variables -** -** The individual timer cells in tiw are also protected by the same mutex. -*/ +#if 0 +# define ERTS_TW_DEBUG +#endif +#if defined(DEBUG) && !defined(ERTS_TW_DEBUG) +# define ERTS_TW_DEBUG +#endif -#ifdef SMALL_MEMORY -#define TIW_SIZE 8192 +#undef ERTS_TW_ASSERT +#if defined(ERTS_TW_DEBUG) +# define ERTS_TW_ASSERT(E) ERTS_ASSERT(E) #else -#define TIW_SIZE 65536 /* timing wheel size (should be a power of 2) */ +# define ERTS_TW_ASSERT(E) ((void) 1) #endif -static ErlTimer** tiw; /* the timing wheel, allocated in init_time() */ -static Uint tiw_pos; /* current position in wheel */ -static Uint tiw_nto; /* number of timeouts in wheel */ -static Uint tiw_min; -static ErlTimer *tiw_min_ptr; -/* END tiw_lock protected variables */ +#ifdef ERTS_TW_DEBUG +# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 5 +#else +# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 100 +#endif /* Actual interval time chosen by sys_init_time() */ @@ -114,209 +118,447 @@ static int tiw_itime; /* Constant after init */ # define TIW_ITIME tiw_itime #endif -erts_smp_atomic32_t do_time; /* set at clock interrupt */ -static ERTS_INLINE erts_short_time_t do_time_read(void) -{ - return erts_smp_atomic32_read_acqb(&do_time); -} - -static ERTS_INLINE erts_short_time_t do_time_update(void) -{ - return do_time_read(); -} - -static ERTS_INLINE void do_time_init(void) -{ - erts_smp_atomic32_init_nob(&do_time, 0); -} +struct ErtsTimerWheel_ { + ErtsTWheelTimer *w[ERTS_TIW_SIZE]; + ErtsMonotonicTime pos; + Uint nto; + struct { + 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; +}; /* get the time (in units of TIW_ITIME) to the next timeout, or -1 if there are no timeouts */ -static erts_short_time_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ +static ERTS_INLINE ErtsMonotonicTime +find_next_timeout(ErtsTimerWheel *tiw, + ErtsMonotonicTime curr_time, + ErtsMonotonicTime max_search_time) { - int i, tm, nto; - Uint32 min; - ErlTimer* p; - erts_short_time_t dt; - - if (tiw_nto == 0) - return -1; /* no timeouts in wheel */ - - if (tiw_min_ptr) { - min = tiw_min; - dt = do_time_read(); - return ((min >= dt) ? (min - dt) : 0); + int start_ix, tiw_pos_ix; + ErtsTWheelTimer *p; + int true_min_timeout; + ErtsMonotonicTime min_timeout, min_timeout_pos, slot_timeout_pos; + + if (tiw->true_next_timeout_time) + return tiw->next_timeout_time; + + if (tiw->nto == 0) { /* no timeouts in wheel */ + true_min_timeout = 0; + min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time + ERTS_MONOTONIC_DAY); + goto found_next; } - - /* start going through wheel to find next timeout */ - tm = nto = 0; - min = (Uint32) -1; /* max Uint32 */ - i = tiw_pos; + + 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 & (ERTS_TIW_SIZE-1)); + do { - p = tiw[i]; - while (p != NULL) { - nto++; - if (p->count == 0) { - /* found next timeout */ - dt = do_time_read(); - /* p->count is zero */ - tiw_min_ptr = p; - tiw_min = tm; - return ((tm >= dt) ? (tm - dt) : 0); - } else { - /* keep shortest time in 'min' */ - if (tm + p->count*TIW_SIZE < min) { - min = tm + p->count*TIW_SIZE; - tiw_min_ptr = p; - tiw_min = min; + slot_timeout_pos++; + if (slot_timeout_pos >= min_timeout_pos) { + true_min_timeout = 0; + break; + } + + p = tiw->w[tiw_pos_ix]; + + 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; + p = p->next; + } while (p != end); } - /* when we have found all timeouts the shortest time will be in min */ - if (nto == tiw_nto) break; - tm++; - i = (i + 1) % TIW_SIZE; - } while (i != tiw_pos); - dt = do_time_read(); - if (min <= (Uint32) dt) - return 0; - if ((min - (Uint32) dt) > (Uint32) ERTS_SHORT_TIME_T_MAX) - return ERTS_SHORT_TIME_T_MAX; - return (erts_short_time_t) (min - (Uint32) dt); + + tiw_pos_ix++; + 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); + tiw->next_timeout_time = min_timeout; + tiw->true_next_timeout_time = true_min_timeout; + + return min_timeout; } -static void remove_timer(ErlTimer *p) { - /* first */ - if (!p->prev) { - tiw[p->slot] = p->next; - if(p->next) - p->next->prev = NULL; - } else { - p->prev->next = p->next; +static ERTS_INLINE void +insert_timer_into_slot(ErtsTimerWheel *tiw, int slot, ErtsTWheelTimer *p) +{ + ERTS_TW_ASSERT(slot >= 0); + ERTS_TW_ASSERT(slot < ERTS_TIW_SIZE); + p->slot = slot; + if (!tiw->w[slot]) { + tiw->w[slot] = p; + p->next = p; + p->prev = p; + } + else { + ErtsTWheelTimer *next, *prev; + next = tiw->w[slot]; + prev = next->prev; + p->next = next; + p->prev = prev; + prev->next = p; + next->prev = p; } +} + +static ERTS_INLINE void +remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) +{ + int slot = p->slot; + ERTS_TW_ASSERT(slot != ERTS_TWHEEL_SLOT_INACTIVE); + + if (slot >= 0) { + /* + * Timer in wheel or in circular + * list of timers currently beeing + * triggered (referred by sentinel). + */ + ERTS_TW_ASSERT(slot < ERTS_TIW_SIZE); - /* last */ - if (!p->next) { + if (p->next == p) { + ERTS_TW_ASSERT(tiw->w[slot] == p); + tiw->w[slot] = NULL; + } + else { + if (tiw->w[slot] == p) + tiw->w[slot] = p->next; + p->prev->next = p->next; + p->next->prev = p->prev; + } + } + else { + /* Timer in "at once" queue... */ + ERTS_TW_ASSERT(slot == ERTS_TWHEEL_SLOT_AT_ONCE); if (p->prev) - p->prev->next = NULL; - } else { - p->next->prev = p->prev; + p->prev->next = p->next; + else { + ERTS_TW_ASSERT(tiw->at_once.head == p); + tiw->at_once.head = p->next; + } + if (p->next) + p->next->prev = p->prev; + else { + ERTS_TW_ASSERT(tiw->at_once.tail == p); + tiw->at_once.tail = p->prev; + } + ERTS_TW_ASSERT(tiw->at_once.nto > 0); + tiw->at_once.nto--; } + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; + +#if 0 p->next = NULL; p->prev = NULL; - /* Make sure cancel callback isn't called */ - p->active = 0; - tiw_nto--; +#endif + + tiw->nto--; } -/* Private export to erl_time_sup.c */ -erts_short_time_t erts_next_time(void) +ErtsMonotonicTime +erts_check_next_timeout_time(ErtsSchedulerData *esdp) { - erts_short_time_t ret; + /* + * 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)); +} - erts_smp_mtx_lock(&tiw_lock); - (void)do_time_update(); - ret = next_time_internal(); - erts_smp_mtx_unlock(&tiw_lock); - return ret; +#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)) +static void +debug_check_safe_to_skip_to(ErtsTimerWheel *tiw, ErtsMonotonicTime skip_to_pos) +{ + int slots, ix; + ErtsTWheelTimer *tmr; + ErtsMonotonicTime tmp; + + ix = (int) (tiw->pos & (ERTS_TIW_SIZE-1)); + tmp = skip_to_pos - tiw->pos; + ERTS_TW_ASSERT(tmp >= 0); + if (tmp < (ErtsMonotonicTime) ERTS_TIW_SIZE) + slots = (int) tmp; + else + slots = ERTS_TIW_SIZE; + + while (slots > 0) { + 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 bump_timer_internal(erts_short_time_t dt) /* PRE: tiw_lock is write-locked */ +static ERTS_INLINE void +timeout_timer(ErtsTWheelTimer *p) { - Uint keep_pos; - Uint count; - ErlTimer *p, **prev, *timeout_head, **timeout_tail; - Uint dtime = (Uint) dt; - - /* no need to bump the position if there aren't any timeouts */ - if (tiw_nto == 0) { - erts_smp_mtx_unlock(&tiw_lock); - return; + 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, yielded_slot_restarted, yield_count; + ErtsMonotonicTime bump_to, tmp_slots, old_pos; + + yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; + + /* + * In order to be fair we always continue with work + * where we left off when restarting after a yield. + */ + + 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; } - /* if do_time > TIW_SIZE we want to go around just once */ - count = (Uint)(dtime / TIW_SIZE) + 1; - keep_pos = (tiw_pos + dtime) % TIW_SIZE; - if (dtime > TIW_SIZE) dtime = TIW_SIZE; - - timeout_head = NULL; - timeout_tail = &timeout_head; - while (dtime > 0) { - /* this is to decrease the counters with the right amount */ - /* when dtime >= TIW_SIZE */ - if (tiw_pos == keep_pos) count--; - prev = &tiw[tiw_pos]; - while ((p = *prev) != NULL) { - ASSERT( p != p->next); - if (p->count < count) { /* we have a timeout */ - /* remove min time */ - if (tiw_min_ptr == p) { - tiw_min_ptr = NULL; - tiw_min = 0; + do { + + yielded_slot_restarted = 0; + + bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); + + while (1) { + ErtsTWheelTimer *p; + + 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; + } + + 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; } - /* Remove from list */ - remove_timer(p); - *timeout_tail = p; /* Insert in timeout queue */ - timeout_tail = &p->next; + 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; + } + + if (tiw->pos >= bump_to) + break; + + if (tiw->nto == 0) + goto empty_wheel; + + 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; + } } - else { - /* no timeout, just decrease counter */ - p->count -= count; - prev = &p->next; + + 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--; } } - tiw_pos = (tiw_pos + 1) % TIW_SIZE; - dtime--; - } - tiw_pos = keep_pos; - if (tiw_min_ptr) - tiw_min -= dt; - - erts_smp_mtx_unlock(&tiw_lock); - - /* Call timedout timers callbacks */ - while (timeout_head) { - 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. - */ - p->next = NULL; - p->prev = NULL; - p->slot = 0; - (*p->timeout)(p->arg); - } -} -void erts_bump_timer(erts_short_time_t dt) /* dt is value from do_time */ -{ - erts_smp_mtx_lock(&tiw_lock); - bump_timer_internal(dt); + } while (yielded_slot_restarted); + + tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + tiw->true_next_timeout_time = 0; + tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; + + /* Search at most two seconds ahead... */ + (void) find_next_timeout(tiw, curr_time, ERTS_SEC_TO_MONOTONIC(2)); } Uint erts_timer_wheel_memory_size(void) { - return (Uint) TIW_SIZE * sizeof(ErlTimer*); + return sizeof(ErtsTimerWheel)*erts_no_schedulers; +} + +ErtsTimerWheel * +erts_create_timer_wheel(ErtsSchedulerData *esdp) +{ + ErtsMonotonicTime mtime; + int i; + ErtsTimerWheel *tiw; + 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; + + 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 = 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; + 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_time; } + /* this routine links the time cells into a free list at the start and sets the time queue as empty */ void -erts_init_time(void) +erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode) { - int i, itime; + int itime; /* system dependent init; must be done before do_time_init() if timer thread is enabled */ - itime = erts_init_time_sup(); + itime = erts_init_time_sup(time_correction, time_warp_mode); #ifdef TIW_ITIME_IS_CONSTANT if (itime != TIW_ITIME) { erl_exit(ERTS_ABORT_EXIT, "timer resolution mismatch %d != %d", itime, TIW_ITIME); @@ -324,182 +566,104 @@ erts_init_time(void) #else tiw_itime = itime; #endif - - erts_smp_mtx_init(&tiw_lock, "timer_wheel"); - - tiw = (ErlTimer**) erts_alloc(ERTS_ALC_T_TIMER_WHEEL, - TIW_SIZE * sizeof(ErlTimer*)); - for(i = 0; i < TIW_SIZE; i++) - tiw[i] = NULL; - do_time_init(); - tiw_pos = tiw_nto = 0; - tiw_min_ptr = NULL; - tiw_min = 0; } - - - -/* -** Insert a process into the time queue, with a timeout 't' -*/ -static void -insert_timer(ErlTimer* p, Uint t) +void +erts_twheel_set_timer(ErtsTimerWheel *tiw, + ErtsTWheelTimer *p, ErlTimeoutProc timeout, + ErlCancelProc cancel, void *arg, + ErtsMonotonicTime timeout_pos) { - Uint tm; - Uint64 ticks; + ErtsMonotonicTime timeout_time; - /* The current slot (tiw_pos) in timing wheel is the next slot to be - * be processed. Hence no extra time tick is needed. - * - * (x + y - 1)/y is precisely the "number of bins" formula. - */ - ticks = (t + (TIW_ITIME - 1)) / TIW_ITIME; - - /* - * Ticks must be a Uint64, or the addition may overflow here, - * resulting in an incorrect value for p->count below. - */ - ticks += do_time_update(); /* Add backlog of unprocessed time */ - - /* calculate slot */ - tm = (ticks + tiw_pos) % TIW_SIZE; - p->slot = (Uint) tm; - p->count = (Uint) (ticks / TIW_SIZE); - - /* insert at head of list at slot */ - p->next = tiw[tm]; - p->prev = NULL; - if (p->next != NULL) - p->next->prev = p; - tiw[tm] = p; + p->u.func.timeout = timeout; + p->u.func.cancel = cancel; + p->u.func.arg = arg; + ERTS_TW_ASSERT(p->slot == ERTS_TWHEEL_SLOT_INACTIVE); - /* insert min time */ - if ((tiw_nto == 0) || ((tiw_min_ptr != NULL) && (ticks < tiw_min))) { - tiw_min = ticks; - tiw_min_ptr = p; - } - if ((tiw_min_ptr == p) && (ticks > tiw_min)) { - /* some other timer might be 'min' now */ - tiw_min = 0; - tiw_min_ptr = NULL; + if (timeout_pos <= tiw->pos) { + tiw->nto++; + tiw->at_once.nto++; + p->next = NULL; + 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 slot; - tiw_nto++; -} + /* calculate slot */ + slot = (int) (timeout_pos & (ERTS_TIW_SIZE-1)); -void -erts_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, - void* arg, Uint t) -{ + insert_timer_into_slot(tiw, slot, p); - erts_deliver_time(); - erts_smp_mtx_lock(&tiw_lock); - if (p->active) { /* XXX assert ? */ - erts_smp_mtx_unlock(&tiw_lock); - return; - } - p->timeout = timeout; - p->cancel = cancel; - p->arg = arg; - p->active = 1; - insert_timer(p, t); - erts_smp_mtx_unlock(&tiw_lock); -#if defined(ERTS_SMP) - if (t <= (Uint) ERTS_SHORT_TIME_T_MAX) - erts_sys_schedule_interrupt_timed(1, (erts_short_time_t) t); -#endif -} + tiw->nto++; -void -erts_cancel_timer(ErlTimer* p) -{ - erts_smp_mtx_lock(&tiw_lock); - if (!p->active) { /* allow repeated cancel (drivers) */ - erts_smp_mtx_unlock(&tiw_lock); - return; + timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(timeout_pos); + p->timeout_pos = timeout_pos; } - /* is it the 'min' timer, remove min */ - if (p == tiw_min_ptr) { - tiw_min_ptr = NULL; - tiw_min = 0; + if (timeout_time < tiw->next_timeout_time) { + tiw->true_next_timeout_time = 1; + tiw->next_timeout_time = timeout_time; } - - remove_timer(p); - p->slot = p->count = 0; - - if (p->cancel != NULL) { - erts_smp_mtx_unlock(&tiw_lock); - (*p->cancel)(p->arg); - return; - } - erts_smp_mtx_unlock(&tiw_lock); } -/* - 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) +void +erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) { - Uint left; - erts_short_time_t dt; - - erts_smp_mtx_lock(&tiw_lock); - - if (!p->active) { - erts_smp_mtx_unlock(&tiw_lock); - return 0; + if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) { + ErlCancelProc cancel; + void *arg; + remove_timer(tiw, p); + cancel = p->u.func.cancel; + arg = p->u.func.arg; + if (cancel) + (*cancel)(arg); } - - if (p->slot < tiw_pos) - left = (p->count + 1) * TIW_SIZE + p->slot - tiw_pos; - else - left = p->count * TIW_SIZE + p->slot - tiw_pos; - dt = do_time_read(); - if (left < dt) - left = 0; - else - left -= dt; - - erts_smp_mtx_unlock(&tiw_lock); - - return (Uint) left * TIW_ITIME; } -#ifdef DEBUG +#ifdef ERTS_TW_DEBUG void erts_p_slpq(void) { + 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("\ntiw_pos = %d tiw_nto %d\n", tiw_pos, tiw_nto); - i = tiw_pos; - if (tiw[i] != NULL) { + erts_printf("\ncurrent time = %bps tiw_pos = %d tiw_nto %d\n", + current_time, tiw->pos, tiw->nto); + i = tiw->pos; + if (tiw->w[i] != NULL) { erts_printf("%d:\n", i); - for(p = tiw[i]; p != NULL; p = p->next) { - erts_printf(" (count %d, slot %d)\n", - p->count, p->slot); + for(p = tiw->w[i]; p != NULL; p = p->next) { + erts_printf(" (timeout time %bps, slot %d)\n", + ERTS_CLKTCKS_TO_MONOTONIC(p->timeout_pos), + p->slot); } } - for(i = (i+1)%TIW_SIZE; i != tiw_pos; i = (i+1)%TIW_SIZE) { - if (tiw[i] != NULL) { + 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[i]; p != NULL; p = p->next) { - erts_printf(" (count %d, slot %d)\n", - p->count, p->slot); + for(p = tiw->w[i]; p != NULL; p = p->next) { + erts_printf(" (timeout time %bps, slot %d)\n", + ERTS_CLKTCKS_TO_MONOTONIC(p->timeout_pos), p->slot); } } } - - 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 b341c4d949..e21e916de5 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -49,6 +49,9 @@ #include "beam_bp.h" #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 @@ -190,12 +193,18 @@ erts_set_hole_marker(Eterm* ptr, Uint sz) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_estack(ErtsEStack* s, Eterm* default_estack) +erl_grow_estack(ErtsEStack* s, Uint need) { Uint old_size = (s->end - s->start); - Uint new_size = old_size * 2; + Uint new_size; Uint sp_offs = s->sp - s->start; - if (s->start != default_estack) { + + if (need < old_size) + new_size = 2*old_size; + else + new_size = ((need / old_size) + 2) * old_size; + + if (s->start != s->edefault) { s->start = erts_realloc(s->alloc_type, s->start, new_size*sizeof(Eterm)); } else { @@ -210,12 +219,18 @@ erl_grow_estack(ErtsEStack* s, Eterm* default_estack) * Helper function for the WSTACK macros defined in global.h. */ void -erl_grow_wstack(ErtsWStack* s, UWord* default_wstack) +erl_grow_wstack(ErtsWStack* s, Uint need) { Uint old_size = (s->wend - s->wstart); - Uint new_size = old_size * 2; + Uint new_size; Uint sp_offs = s->wsp - s->wstart; - if (s->wstart != default_wstack) { + + if (need < old_size) + new_size = 2 * old_size; + else + new_size = ((need / old_size) + 2) * old_size; + + if (s->wstart != s->wdefault) { s->wstart = erts_realloc(s->alloc_type, s->wstart, new_size*sizeof(UWord)); } else { @@ -227,6 +242,32 @@ erl_grow_wstack(ErtsWStack* s, UWord* default_wstack) s->wsp = s->wstart + sp_offs; } +/* + * Helper function for the PSTACK macros defined in global.h. + */ +void +erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes) +{ + Uint old_size = s->pend - s->pstart; + Uint new_size; + Uint sp_offs = s->psp - s->pstart; + + if (need_bytes < old_size) + new_size = 2 * old_size; + else + new_size = ((need_bytes / old_size) + 2) * old_size; + + if (s->pstart != default_pstack) { + s->pstart = erts_realloc(s->alloc_type, s->pstart, new_size); + } else { + byte* new_ptr = erts_alloc(s->alloc_type, new_size); + sys_memcpy(new_ptr, s->pstart, old_size); + s->pstart = new_ptr; + } + s->pend = s->pstart + new_size; + s->psp = s->pstart + sp_offs; +} + /* CTYPE macros */ #define LATIN1 @@ -314,6 +355,17 @@ int erts_fit_in_bits_int32(Sint32 value) return fit_in_bits((Sint64) (Uint32) value, 4); } +int erts_fit_in_bits_uint(Uint value) +{ +#if ERTS_SIZEOF_ETERM == 4 + return fit_in_bits((Sint64) (Uint32) value, 4); +#elif ERTS_SIZEOF_ETERM == 8 + return fit_in_bits(value, 5); +#else +# error "No way, Jose" +#endif +} + int erts_print(int to, void *arg, char *format, ...) { @@ -710,7 +762,7 @@ erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length, ** If N < 0, Y = FUNNY_NUMBER4 else Y = FUNNY_NUMBER3. ** The hash value is Y*h(J) mod 2^32 where h(J) is calculated like ** h(0) = <initial hash> -** h(i) = h(i-i)*X + B(i-1) +** h(i) = h(i-1)*X + B(i-1) ** The above should hold regardless of internal representation. ** Pids are hashed like small numbers but with differrent constants, as are ** ports. @@ -792,10 +844,10 @@ Uint32 make_hash(Eterm term_arg) unsigned op; /* Must not collide with the real tag_val_def's: */ -#define MAKE_HASH_TUPLE_OP 0x11 -#define MAKE_HASH_TERM_ARRAY_OP 0x12 -#define MAKE_HASH_CDR_PRE_OP 0x13 -#define MAKE_HASH_CDR_POST_OP 0x14 +#define MAKE_HASH_TUPLE_OP (FIRST_VACANT_TAG_DEF) +#define MAKE_HASH_TERM_ARRAY_OP (FIRST_VACANT_TAG_DEF+1) +#define MAKE_HASH_CDR_PRE_OP (FIRST_VACANT_TAG_DEF+2) +#define MAKE_HASH_CDR_POST_OP (FIRST_VACANT_TAG_DEF+3) /* ** Convenience macro for calculating a bytewise hash on an unsigned 32 bit @@ -905,12 +957,15 @@ tail_recur: UINT32_HASH_RET(external_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10); case FLOAT_DEF: { - FloatDef ff; - GET_DOUBLE(term, ff); - hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); - break; + FloatDef ff; + GET_DOUBLE(term, ff); + if (ff.fd == 0.0f) { + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); + } + hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); + break; } - case MAKE_HASH_CDR_PRE_OP: term = (Eterm) WSTACK_POP(stack); if (is_not_list(term)) { @@ -975,23 +1030,8 @@ tail_recur: break; } case MAP_DEF: - { - map_t *mp = (map_t *)map_val(term); - int size = map_get_size(mp); - Eterm *ks = map_get_keys(mp); - Eterm *vs = map_get_values(mp); - - /* Use a prime with size to remedy some of - * the {} and <<>> hash problems */ - hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size; - if (size == 0) - break; - - /* push values first */ - WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); - WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); - break; - } + hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + make_hash2(term); + break; case TUPLE_DEF: { Eterm* ptr = tuple_val(term); @@ -1095,10 +1135,11 @@ Uint32 make_hash2(Eterm term) { Uint32 hash; - Uint32 hash_xor_keys = 0; - Uint32 hash_xor_values = 0; + Uint32 hash_xor_pairs; DeclareTmpHeapNoproc(tmp_big,2); + ERTS_UNDEF(hash_xor_pairs, 0); + /* (HCONST * {2, ..., 16}) mod 2^32 */ #define HCONST_2 0x3c6ef372UL #define HCONST_3 0xdaa66d2bUL @@ -1115,10 +1156,15 @@ make_hash2(Eterm term) #define HCONST_14 0xa708a81eUL #define HCONST_15 0x454021d7UL #define HCONST_16 0xe3779b90UL +#define HCONST_17 0x81af1549UL +#define HCONST_18 0x1fe68f02UL +#define HCONST_19 0xbe1e08bbUL +#define HCONST_20 0x5c558274UL +#define HCONST_21 0xfa8cfc2dUL #define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF)) -#define HASH_MAP_KEY (_make_header(2,_TAG_HEADER_REF)) -#define HASH_MAP_VAL (_make_header(3,_TAG_HEADER_REF)) +#define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF)) +#define HASH_CDR (_make_header(3,_TAG_HEADER_REF)) #define UINT32_HASH_2(Expr1, Expr2, AConst) \ do { \ @@ -1141,6 +1187,13 @@ make_hash2(Eterm term) } while(0) #define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2) + +#ifdef ARCH_64 +# define POINTER_HASH(Ptr, AConst) UINT32_HASH_2((Uint32)(UWord)(Ptr), (((UWord)(Ptr)) >> 32), AConst) +#else +# define POINTER_HASH(Ptr, AConst) UINT32_HASH(Ptr, AConst) +#endif + /* Optimization. Simple cases before declaration of estack. */ if (primary_tag(term) == TAG_PRIMARY_IMMED1) { switch (term & _TAG_IMMED1_MASK) { @@ -1195,9 +1248,9 @@ make_hash2(Eterm term) if (c > 0) UINT32_HASH(sh, HCONST_4); if (is_list(term)) { - term = *ptr; - tmp = *++ptr; - ESTACK_PUSH(s, tmp); + tmp = CDR(ptr); + ESTACK_PUSH(s, tmp); + term = CAR(ptr); } } break; @@ -1214,46 +1267,90 @@ make_hash2(Eterm term) UINT32_HASH(arity, HCONST_9); if (arity == 0) /* Empty tuple */ goto hash2_common; - for (i = arity; i >= 1; i--) { - tmp = elem[i]; - ESTACK_PUSH(s, tmp); - } - goto hash2_common; - } - break; - case MAP_SUBTAG: - { - map_t *mp = (map_t *)map_val(term); - int i; - int size = map_get_size(mp); - Eterm *ks = map_get_keys(mp); - Eterm *vs = map_get_values(mp); - UINT32_HASH(size, HCONST_16); - if (size == 0) { - goto hash2_common; - } - ESTACK_PUSH4(s, hash_xor_values, hash_xor_keys, hash, HASH_MAP_TAIL); - hash = 0; - hash_xor_keys = 0; - hash_xor_values = 0; - for (i = size - 1; i >= 0; i--) { - tmp = vs[i]; - ESTACK_PUSH2(s, HASH_MAP_VAL, tmp); - } - /* We do not want to expose the tuple representation. - * Do not push the keys as a tuple. - */ - for (i = size - 1; i >= 0; i--) { - tmp = ks[i]; - ESTACK_PUSH2(s, HASH_MAP_KEY, tmp); + for (i = arity; ; i--) { + term = elem[i]; + if (i == 1) + break; + ESTACK_PUSH(s, term); } - goto hash2_common; } break; + case MAP_SUBTAG: + { + Eterm* ptr = boxed_val(term) + 1; + Uint size; + int i; + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_FLATMAP: + { + flatmap_t *mp = (flatmap_t *)flatmap_val(term); + Eterm *ks = flatmap_get_keys(mp); + Eterm *vs = flatmap_get_values(mp); + size = flatmap_get_size(mp); + UINT32_HASH(size, HCONST_16); + if (size == 0) + goto hash2_common; + + /* We want a portable hash function that is *independent* of + * the order in which keys and values are encountered. + * We therefore calculate context independent hashes for all . + * key-value pairs and then xor them together. + */ + ESTACK_PUSH(s, hash_xor_pairs); + ESTACK_PUSH(s, hash); + ESTACK_PUSH(s, HASH_MAP_TAIL); + hash = 0; + hash_xor_pairs = 0; + for (i = size - 1; i >= 0; i--) { + ESTACK_PUSH(s, HASH_MAP_PAIR); + ESTACK_PUSH(s, vs[i]); + ESTACK_PUSH(s, ks[i]); + } + goto hash2_common; + } + + case HAMT_SUBTAG_HEAD_ARRAY: + case HAMT_SUBTAG_HEAD_BITMAP: + size = *ptr++; + UINT32_HASH(size, HCONST_16); + if (size == 0) + goto hash2_common; + ESTACK_PUSH(s, hash_xor_pairs); + ESTACK_PUSH(s, hash); + ESTACK_PUSH(s, HASH_MAP_TAIL); + hash = 0; + hash_xor_pairs = 0; + } + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + i = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + case HAMT_SUBTAG_NODE_BITMAP: + i = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + break; + default: + erl_exit(1, "bad header"); + } + while (i) { + if (is_list(*ptr)) { + Eterm* cons = list_val(*ptr); + ESTACK_PUSH(s, HASH_MAP_PAIR); + ESTACK_PUSH(s, CDR(cons)); + ESTACK_PUSH(s, CAR(cons)); + } + else { + ASSERT(is_boxed(*ptr)); + ESTACK_PUSH(s, *ptr); + } + i--; ptr++; + } + goto hash2_common; + } + break; case EXPORT_SUBTAG: { Export* ep = *((Export **) (export_val(term) + 1)); - UINT32_HASH_2 (ep->code[2], atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue, @@ -1268,7 +1365,6 @@ make_hash2(Eterm term) { ErlFunThing* funp = (ErlFunThing *) fun_val(term); Uint num_free = funp->num_free; - UINT32_HASH_2 (num_free, atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue, @@ -1349,7 +1445,8 @@ make_hash2(Eterm term) do { Uint t; Uint32 x, y; - t = i < n ? BIG_DIGIT(ptr, i++) : 0; + ASSERT(i < n); + t = BIG_DIGIT(ptr, i++); x = t & 0xffffffff; y = t >> 32; UINT32_HASH_2(x, y, con); @@ -1382,6 +1479,10 @@ make_hash2(Eterm term) { FloatDef ff; GET_DOUBLE(term, ff); + if (ff.fd == 0.0f) { + /* 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); #else @@ -1457,20 +1558,396 @@ make_hash2(Eterm term) switch (term) { case HASH_MAP_TAIL: { hash = (Uint32) ESTACK_POP(s); - UINT32_HASH(hash_xor_keys, HCONST_16); - UINT32_HASH(hash_xor_values, HCONST_16); - hash_xor_keys = (Uint32) ESTACK_POP(s); - hash_xor_values = (Uint32) ESTACK_POP(s); + UINT32_HASH(hash_xor_pairs, HCONST_19); + hash_xor_pairs = (Uint32) ESTACK_POP(s); goto hash2_common; } - case HASH_MAP_KEY: - hash_xor_keys ^= hash; + case HASH_MAP_PAIR: + hash_xor_pairs ^= hash; hash = 0; goto hash2_common; - case HASH_MAP_VAL: - hash_xor_values ^= hash; + default: + break; + } + } + } + } +} + +/* Term hash function for internal use. + * + * Limitation #1: Is not "portable" in any way between different VM instances. + * + * Limitation #2: The hash value is only valid as long as the term exists + * somewhere in the VM. Why? Because external pids, ports and refs are hashed + * by mixing the node *pointer* value. If a node disappears and later reappears + * with a new ErlNode struct, externals from that node will hash different than + * before. + * + * One IMPORTANT property must hold (for hamt). + * EVERY BIT of the term that is significant for equality (see EQ) + * MUST BE USED AS INPUT FOR THE HASH. Two different terms must always have a + * chance of hashing different when salted: hash([Salt|A]) vs hash([Salt|B]). + * + * This is why we can not use cached hash values for atoms for example. + * + */ + +#define CONST_HASH(AConst) \ +do { /* Lightweight mixing of constant (type info) */ \ + hash ^= AConst; \ + hash = (hash << 17) ^ (hash >> (32-17)); \ +} while (0) + +Uint32 +make_internal_hash(Eterm term) +{ + Uint32 hash; + Uint32 hash_xor_pairs; + + ERTS_UNDEF(hash_xor_pairs, 0); + + /* Optimization. Simple cases before declaration of estack. */ + if (primary_tag(term) == TAG_PRIMARY_IMMED1) { + hash = 0; + #if ERTS_SIZEOF_ETERM == 8 + UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST); + #elif ERTS_SIZEOF_ETERM == 4 + UINT32_HASH(term, HCONST); + #else + # error "No you don't" + #endif + return hash; + } + { + Eterm tmp; + DECLARE_ESTACK(s); + + hash = 0; + for (;;) { + switch (primary_tag(term)) { + case TAG_PRIMARY_LIST: + { + int c = 0; + Uint32 sh = 0; + Eterm* ptr = list_val(term); + while (is_byte(*ptr)) { + /* Optimization for strings. */ + sh = (sh << 8) + unsigned_val(*ptr); + if (c == 3) { + UINT32_HASH(sh, HCONST_4); + c = sh = 0; + } else { + c++; + } + term = CDR(ptr); + if (is_not_list(term)) + break; + ptr = list_val(term); + } + if (c > 0) + UINT32_HASH(sh, HCONST_4); + if (is_list(term)) { + tmp = CDR(ptr); + CONST_HASH(HCONST_17); /* Hash CAR in cons cell */ + ESTACK_PUSH(s, tmp); + if (is_not_list(tmp)) { + ESTACK_PUSH(s, HASH_CDR); + } + term = CAR(ptr); + } + } + break; + case TAG_PRIMARY_BOXED: + { + Eterm hdr = *boxed_val(term); + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + { + int i; + int arity = header_arity(hdr); + Eterm* elem = tuple_val(term); + UINT32_HASH(arity, HCONST_9); + if (arity == 0) /* Empty tuple */ + goto pop_next; + for (i = arity; ; i--) { + term = elem[i]; + if (i == 1) + break; + ESTACK_PUSH(s, term); + } + } + break; + + case MAP_SUBTAG: + { + Eterm* ptr = boxed_val(term) + 1; + Uint size; + int i; + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_FLATMAP: + { + flatmap_t *mp = (flatmap_t *)flatmap_val(term); + Eterm *ks = flatmap_get_keys(mp); + Eterm *vs = flatmap_get_values(mp); + size = flatmap_get_size(mp); + UINT32_HASH(size, HCONST_16); + if (size == 0) + goto pop_next; + + /* We want a hash function that is *independent* of + * the order in which keys and values are encountered. + * We therefore calculate context independent hashes for all . + * key-value pairs and then xor them together. + */ + ESTACK_PUSH(s, hash_xor_pairs); + ESTACK_PUSH(s, hash); + ESTACK_PUSH(s, HASH_MAP_TAIL); + hash = 0; + hash_xor_pairs = 0; + for (i = size - 1; i >= 0; i--) { + ESTACK_PUSH(s, HASH_MAP_PAIR); + ESTACK_PUSH(s, vs[i]); + ESTACK_PUSH(s, ks[i]); + } + goto pop_next; + } + case HAMT_SUBTAG_HEAD_ARRAY: + case HAMT_SUBTAG_HEAD_BITMAP: + size = *ptr++; + UINT32_HASH(size, HCONST_16); + if (size == 0) + goto pop_next; + ESTACK_PUSH(s, hash_xor_pairs); + ESTACK_PUSH(s, hash); + ESTACK_PUSH(s, HASH_MAP_TAIL); + hash = 0; + hash_xor_pairs = 0; + } + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + i = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + case HAMT_SUBTAG_NODE_BITMAP: + i = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + break; + default: + erl_exit(1, "bad header"); + } + while (i) { + if (is_list(*ptr)) { + Eterm* cons = list_val(*ptr); + ESTACK_PUSH(s, HASH_MAP_PAIR); + ESTACK_PUSH(s, CDR(cons)); + ESTACK_PUSH(s, CAR(cons)); + } + else { + ASSERT(is_boxed(*ptr)); + ESTACK_PUSH(s, *ptr); + } + i--; ptr++; + } + goto pop_next; + } + break; + case EXPORT_SUBTAG: + { + Export* ep = *((Export **) (export_val(term) + 1)); + /* Assumes Export entries never moves */ + POINTER_HASH(ep, HCONST_14); + goto pop_next; + } + + case FUN_SUBTAG: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(term); + Uint num_free = funp->num_free; + UINT32_HASH_2(num_free, funp->fe->module, HCONST_20); + UINT32_HASH_2(funp->fe->old_index, funp->fe->old_uniq, HCONST_21); + if (num_free == 0) { + goto pop_next; + } else { + Eterm* bptr = funp->env + num_free - 1; + while (num_free-- > 1) { + term = *bptr--; + ESTACK_PUSH(s, term); + } + term = *bptr; + } + } + break; + case REFC_BINARY_SUBTAG: + case HEAP_BINARY_SUBTAG: + case SUB_BINARY_SUBTAG: + { + byte* bptr; + unsigned sz = binary_size(term); + Uint32 con = HCONST_13 + hash; + Uint bitoffs; + Uint bitsize; + + ERTS_GET_BINARY_BYTES(term, bptr, bitoffs, bitsize); + if (sz == 0 && bitsize == 0) { + hash = con; + } else { + if (bitoffs == 0) { + hash = block_hash(bptr, sz, con); + if (bitsize > 0) { + UINT32_HASH_2(bitsize, (bptr[sz] >> (8 - bitsize)), + HCONST_15); + } + } else { + byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, + sz + (bitsize != 0)); + erts_copy_bits(bptr, bitoffs, 1, buf, 0, 1, sz*8+bitsize); + hash = block_hash(buf, sz, con); + if (bitsize > 0) { + UINT32_HASH_2(bitsize, (buf[sz] >> (8 - bitsize)), + HCONST_15); + } + erts_free(ERTS_ALC_T_TMP, (void *) buf); + } + } + goto pop_next; + } + break; + case POS_BIG_SUBTAG: + case NEG_BIG_SUBTAG: + { + Eterm* ptr = big_val(term); + Uint i = 0; + Uint n = BIG_SIZE(ptr); + Uint32 con = BIG_SIGN(ptr) ? HCONST_10 : HCONST_11; +#if D_EXP == 16 + do { + Uint32 x, y; + x = i < n ? BIG_DIGIT(ptr, i++) : 0; + x += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; + y = i < n ? BIG_DIGIT(ptr, i++) : 0; + y += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; + UINT32_HASH_2(x, y, con); + } while (i < n); +#elif D_EXP == 32 + do { + Uint32 x, y; + x = i < n ? BIG_DIGIT(ptr, i++) : 0; + y = i < n ? BIG_DIGIT(ptr, i++) : 0; + UINT32_HASH_2(x, y, con); + } while (i < n); +#elif D_EXP == 64 + do { + Uint t; + Uint32 x, y; + ASSERT(i < n); + t = BIG_DIGIT(ptr, i++); + x = t & 0xffffffff; + y = t >> 32; + UINT32_HASH_2(x, y, con); + } while (i < n); +#else +#error "unsupported D_EXP size" +#endif + goto pop_next; + } + break; + case REF_SUBTAG: + UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7); + ASSERT(internal_ref_no_of_numbers(term) == 3); + UINT32_HASH_2(internal_ref_numbers(term)[1], + internal_ref_numbers(term)[2], HCONST_8); + goto pop_next; + + case EXTERNAL_REF_SUBTAG: + { + ExternalThing* thing = external_thing_ptr(term); + + ASSERT(external_thing_ref_no_of_numbers(thing) == 3); + /* See limitation #2 */ + #ifdef ARCH_64 + POINTER_HASH(thing->node, HCONST_7); + UINT32_HASH(external_thing_ref_numbers(thing)[0], HCONST_7); + #else + UINT32_HASH_2(thing->node, + external_thing_ref_numbers(thing)[0], HCONST_7); + #endif + UINT32_HASH_2(external_thing_ref_numbers(thing)[1], + external_thing_ref_numbers(thing)[2], HCONST_8); + goto pop_next; + } + case EXTERNAL_PID_SUBTAG: { + ExternalThing* thing = external_thing_ptr(term); + /* See limitation #2 */ + #ifdef ARCH_64 + POINTER_HASH(thing->node, HCONST_5); + UINT32_HASH(thing->data.ui[0], HCONST_5); + #else + UINT32_HASH_2(thing->node, thing->data.ui[0], HCONST_5); + #endif + goto pop_next; + } + case EXTERNAL_PORT_SUBTAG: { + ExternalThing* thing = external_thing_ptr(term); + /* See limitation #2 */ + #ifdef ARCH_64 + POINTER_HASH(thing->node, HCONST_6); + UINT32_HASH(thing->data.ui[0], HCONST_6); + #else + UINT32_HASH_2(thing->node, thing->data.ui[0], HCONST_6); + #endif + goto pop_next; + } + case FLOAT_SUBTAG: + { + FloatDef ff; + GET_DOUBLE(term, ff); + if (ff.fd == 0.0f) { + /* 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; + } + default: + erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); + } + } + break; + case TAG_PRIMARY_IMMED1: + #if ERTS_SIZEOF_ETERM == 8 + UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST); + #else + UINT32_HASH(term, HCONST); + #endif + goto pop_next; + + default: + erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); + + pop_next: + if (ESTACK_ISEMPTY(s)) { + DESTROY_ESTACK(s); + return hash; + } + + term = ESTACK_POP(s); + + switch (term) { + case HASH_MAP_TAIL: { + hash = (Uint32) ESTACK_POP(s); + UINT32_HASH(hash_xor_pairs, HCONST_19); + hash_xor_pairs = (Uint32) ESTACK_POP(s); + goto pop_next; + } + case HASH_MAP_PAIR: + hash_xor_pairs ^= hash; hash = 0; - goto hash2_common; + goto pop_next; + + case HASH_CDR: + CONST_HASH(HCONST_18); /* Hash CDR i cons cell */ + goto pop_next; default: break; } @@ -1478,9 +1955,10 @@ make_hash2(Eterm term) } } +#undef CONST_HASH #undef HASH_MAP_TAIL -#undef HASH_MAP_KEY -#undef HASH_MAP_VAL +#undef HASH_MAP_PAIR +#undef HASH_CDR #undef UINT32_HASH_2 #undef UINT32_HASH @@ -1611,12 +2089,15 @@ tail_recur: break; case FLOAT_DEF: { - FloatDef ff; - GET_DOUBLE(term, ff); - hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); + FloatDef ff; + GET_DOUBLE(term, ff); + if (ff.fd == 0.0f) { + /* ensure positive 0.0 */ + ff.fd = erts_get_positive_zero_float(); + } + hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); } break; - case MAKE_HASH_CDR_PRE_OP: term = (Eterm) WSTACK_POP(stack); if (is_not_list(term)) { @@ -1697,23 +2178,8 @@ tail_recur: break; case MAP_DEF: - { - map_t *mp = (map_t *)map_val(term); - int size = map_get_size(mp); - Eterm *ks = map_get_keys(mp); - Eterm *vs = map_get_values(mp); - - /* Use a prime with size to remedy some of - * the {} and <<>> hash problems */ - hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size; - if (size == 0) - break; - - /* push values first */ - WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); - WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); - break; - } + hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + make_hash2(term); + break; case TUPLE_DEF: { Eterm* ptr = tuple_val(term); @@ -1845,11 +2311,7 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) erts_queue_error_logger_message(from, tuple3, bp); } #else - erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL); #endif return 0; } @@ -2118,22 +2580,6 @@ tailrecur_ne: ++bb; goto term_array; } - case MAP_SUBTAG: - { - aa = map_val_rel(a, a_base); - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) - goto not_equal; - bb = map_val_rel(b,b_base); - sz = map_get_size((map_t*)aa); - - if (sz != map_get_size((map_t*)bb)) goto not_equal; - if (sz == 0) goto pop_next; - - aa += 2; - bb += 2; - sz += 1; /* increment for tuple-keys */ - goto term_array; - } case REFC_BINARY_SUBTAG: case HEAP_BINARY_SUBTAG: case SUB_BINARY_SUBTAG: @@ -2325,6 +2771,46 @@ tailrecur_ne: } break; /* not equal */ } + case MAP_SUBTAG: + if (is_flatmap_rel(a, a_base)) { + aa = flatmap_val_rel(a, a_base); + if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) + goto not_equal; + bb = flatmap_val_rel(b,b_base); + sz = flatmap_get_size((flatmap_t*)aa); + + if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal; + if (sz == 0) goto pop_next; + + aa += 2; + bb += 2; + sz += 1; /* increment for tuple-keys */ + goto term_array; + + } else { + if (!is_boxed(b) || *boxed_val_rel(b,b_base) != hdr) + goto not_equal; + + aa = hashmap_val_rel(a, a_base) + 1; + bb = hashmap_val_rel(b, b_base) + 1; + switch (hdr & _HEADER_MAP_SUBTAG_MASK) { + case HAMT_SUBTAG_HEAD_ARRAY: + aa++; bb++; + sz = 16; + break; + case HAMT_SUBTAG_HEAD_BITMAP: + aa++; bb++; + case HAMT_SUBTAG_NODE_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ASSERT(sz > 0 && sz < 17); + break; + default: + erl_exit(1, "Unknown hashmap subsubtag\n"); + } + goto term_array; + } + default: + ASSERT(!"Unknown boxed subtab in EQ"); } break; } @@ -2434,21 +2920,68 @@ static int cmp_atoms(Eterm a, Eterm b) */ Sint cmp(Eterm a, Eterm b) { - return erts_cmp(a, b, 0); + return erts_cmp(a, b, 0, 0); } #endif +#if HALFWORD_HEAP +static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base, + Eterm b, Eterm* b_base, + int exact, int eq_only); +#else +static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only); +#endif + +#if HALFWORD_HEAP +Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base, + Eterm b, Eterm* b_base, + int exact, int eq_only) +#else +Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) +#endif +{ + if (is_atom(a) && is_atom(b)) { + return cmp_atoms(a, b); + } else if (is_both_small(a, b)) { + return (signed_val(a) - signed_val(b)); + } else if (is_float_rel(a, a_base) && is_float_rel(b, b_base)) { + FloatDef af, bf; + GET_DOUBLE_REL(a, af, a_base); + GET_DOUBLE_REL(b, bf, b_base); + return float_comp(af.fd, bf.fd); + } +#if HALFWORD_HEAP + return erts_cmp_compound_rel_opt(a,a_base,b,b_base,exact,eq_only); +#else + return erts_cmp_compound(a,b,exact,eq_only); +#endif +} + + /* erts_cmp(Eterm a, Eterm b, int exact) * exact = 1 -> term-based compare * exact = 0 -> arith-based compare */ #if HALFWORD_HEAP -Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base, int exact) +static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base, + Eterm b, Eterm* b_base, + int exact, int eq_only) #else -Sint erts_cmp(Eterm a, Eterm b, int exact) +static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) #endif { - DECLARE_WSTACK(stack); +#define PSTACK_TYPE struct erts_cmp_hashmap_state + struct erts_cmp_hashmap_state { + Sint wstack_rollback; + int was_exact; + Eterm *ap; + Eterm *bp; + Eterm min_key; + Sint cmp_res; /* result so far -1,0,+1 */ + }; + PSTACK_DECLARE(hmap_stack, 1); + WSTACK_DECLARE(stack); + WSTACK_DECLARE(b_stack); /* only used by hashmaps */ Eterm* aa; Eterm* bb; int i; @@ -2464,6 +2997,26 @@ Sint erts_cmp(Eterm a, Eterm b, int exact) Uint32 *anum; Uint32 *bnum; +/* The WSTACK contains naked Eterms and Operations marked with header-tags */ +#define OP_BITS 4 +#define OP_MASK 0xF +#define TERM_ARRAY_OP 0 +#define SWITCH_EXACT_OFF_OP 1 +#define HASHMAP_PHASE1_ARE_KEYS_EQUAL 2 +#define HASHMAP_PHASE1_IS_MIN_KEY 3 +#define HASHMAP_PHASE1_CMP_VALUES 4 +#define HASHMAP_PHASE2_ARE_KEYS_EQUAL 5 +#define HASHMAP_PHASE2_IS_MIN_KEY_A 6 +#define HASHMAP_PHASE2_IS_MIN_KEY_B 7 + + +#define OP_WORD(OP) (((OP) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER) +#define TERM_ARRAY_OP_WORD(SZ) OP_WORD(((SZ) << OP_BITS) | TERM_ARRAY_OP) + +#define GET_OP(WORD) (ASSERT(is_header(WORD)), ((WORD) >> _TAG_PRIMARY_SIZE) & OP_MASK) +#define GET_OP_ARG(WORD) (ASSERT(is_header(WORD)), ((WORD) >> (OP_BITS + _TAG_PRIMARY_SIZE))) + + #define RETURN_NEQ(cmp) { j=(cmp); ASSERT(j != 0); goto not_equal; } #define ON_CMP_GOTO(cmp) if ((j=(cmp)) == 0) goto pop_next; else goto not_equal @@ -2479,6 +3032,8 @@ Sint erts_cmp(Eterm a, Eterm b, int exact) } while (0) +bodyrecur: + j = 0; tailrecur: if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */ goto pop_next; @@ -2605,25 +3160,96 @@ tailrecur_ne: ++aa; ++bb; goto term_array; - case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) : - if (!is_map_rel(b,b_base)) { - a_tag = MAP_DEF; - goto mixed_types; - } - aa = (Eterm *)map_val_rel(a,a_base); - bb = (Eterm *)map_val_rel(b,b_base); - - i = map_get_size((map_t*)aa); - if (i != map_get_size((map_t*)bb)) { - RETURN_NEQ((int)(i - map_get_size((map_t*)bb))); - } - if (i == 0) { - goto pop_next; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) : + { + struct erts_cmp_hashmap_state* sp; + if (is_flatmap_header(ahdr)) { + if (!is_flatmap_rel(b,b_base)) { + if (is_hashmap_rel(b,b_base)) { + aa = (Eterm *)flatmap_val_rel(a,a_base); + i = flatmap_get_size((flatmap_t*)aa) - hashmap_size_rel(b,b_base); + ASSERT(i != 0); + RETURN_NEQ(i); + } + a_tag = MAP_DEF; + goto mixed_types; + } + aa = (Eterm *)flatmap_val_rel(a,a_base); + bb = (Eterm *)flatmap_val_rel(b,b_base); + + i = flatmap_get_size((flatmap_t*)aa); + if (i != flatmap_get_size((flatmap_t*)bb)) { + RETURN_NEQ((int)(i - flatmap_get_size((flatmap_t*)bb))); + } + if (i == 0) { + goto pop_next; + } + aa += 2; + bb += 2; + if (exact) { + i += 1; /* increment for tuple-keys */ + goto term_array; + } + else { + /* Value array */ + WSTACK_PUSH3(stack,(UWord)(bb+1),(UWord)(aa+1),TERM_ARRAY_OP_WORD(i)); + /* Switch back from 'exact' key compare */ + WSTACK_PUSH(stack,OP_WORD(SWITCH_EXACT_OFF_OP)); + /* Now do 'exact' compare of key tuples */ + a = *aa; + b = *bb; + exact = 1; + goto bodyrecur; + } + } + if (!is_hashmap_rel(b,b_base)) { + if (is_flatmap_rel(b,b_base)) { + bb = (Eterm *)flatmap_val_rel(b,b_base); + i = hashmap_size_rel(a,a_base) - flatmap_get_size((flatmap_t*)bb); + ASSERT(i != 0); + RETURN_NEQ(i); + } + a_tag = MAP_DEF; + goto mixed_types; + } + i = hashmap_size_rel(a,a_base) - hashmap_size_rel(b,b_base); + if (i) { + RETURN_NEQ(i); + } + if (hashmap_size_rel(a,a_base) == 0) { + goto pop_next; + } + + /* Hashmap compare strategy: + Phase 1. While keys are identical + Do synchronous stepping through leafs of both trees in hash + order. Maintain value compare result of minimal key. + + Phase 2. If key diff was found in phase 1 + Ignore values from now on. + Continue iterate trees by always advancing the one + lagging behind hash-wise. Identical keys are skipped. + A minimal key can only be candidate as tie-breaker if we + have passed that hash value in the other tree (which means + the key did not exist in the other tree). + */ + + sp = PSTACK_PUSH(hmap_stack); + hashmap_iterator_init(&stack, a, 0); + hashmap_iterator_init(&b_stack, b, 0); + sp->ap = hashmap_iterator_next(&stack); + sp->bp = hashmap_iterator_next(&b_stack); + sp->cmp_res = 0; + ASSERT(sp->ap && sp->bp); + + a = CAR(sp->ap); + b = CAR(sp->bp); + sp->was_exact = exact; + exact = 1; + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; } - aa += 2; - bb += 2; - i += 1; /* increment for tuple-keys */ - goto term_array; case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): if (!is_float_rel(b,b_base)) { a_tag = FLOAT_DEF; @@ -2983,8 +3609,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ goto not_equal; } } else { - /* (ab)Use TAG_PRIMARY_HEADER to recognize a term_array */ - WSTACK_PUSH3(stack, i, (UWord)bb, (UWord)aa | TAG_PRIMARY_HEADER); + WSTACK_PUSH3(stack, (UWord)bb, (UWord)aa, TERM_ARRAY_OP_WORD(i)); goto tailrecur_ne; } } @@ -2996,22 +3621,179 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ pop_next: if (!WSTACK_ISEMPTY(stack)) { UWord something = WSTACK_POP(stack); - if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* a term_array */ - aa = (Eterm*) something; - bb = (Eterm*) WSTACK_POP(stack); - i = WSTACK_POP(stack); - goto term_array; + struct erts_cmp_hashmap_state* sp; + if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* an operation */ + switch (GET_OP(something)) { + case TERM_ARRAY_OP: + i = GET_OP_ARG(something); + aa = (Eterm*)WSTACK_POP(stack); + bb = (Eterm*) WSTACK_POP(stack); + goto term_array; + + case SWITCH_EXACT_OFF_OP: + /* Done with exact compare of map keys, switch back */ + ASSERT(exact); + exact = 0; + goto pop_next; + + case HASHMAP_PHASE1_ARE_KEYS_EQUAL: { + sp = PSTACK_TOP(hmap_stack); + if (j) { + /* Key diff found, enter phase 2 */ + if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) { + sp->min_key = CAR(sp->ap); + sp->cmp_res = -1; + sp->ap = hashmap_iterator_next(&stack); + } + else { + sp->min_key = CAR(sp->bp); + sp->cmp_res = 1; + sp->bp = hashmap_iterator_next(&b_stack); + } + exact = 1; /* only exact key compares in phase 2 */ + goto case_HASHMAP_PHASE2_LOOP; + } + + /* No key diff found so far, compare values if min key */ + + if (sp->cmp_res) { + a = CAR(sp->ap); + b = sp->min_key; + exact = 1; + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_IS_MIN_KEY)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + } + /* no min key-value found yet */ + a = CDR(sp->ap); + b = CDR(sp->bp); + exact = sp->was_exact; + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + } + case HASHMAP_PHASE1_IS_MIN_KEY: + sp = PSTACK_TOP(hmap_stack); + if (j < 0) { + a = CDR(sp->ap); + b = CDR(sp->bp); + exact = sp->was_exact; + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + } + goto case_HASHMAP_PHASE1_LOOP; + + case HASHMAP_PHASE1_CMP_VALUES: + sp = PSTACK_TOP(hmap_stack); + if (j) { + sp->cmp_res = j; + sp->min_key = CAR(sp->ap); + } + case_HASHMAP_PHASE1_LOOP: + sp->ap = hashmap_iterator_next(&stack); + sp->bp = hashmap_iterator_next(&b_stack); + if (!sp->ap) { + /* end of maps with identical keys */ + ASSERT(!sp->bp); + j = sp->cmp_res; + exact = sp->was_exact; + (void) PSTACK_POP(hmap_stack); + ON_CMP_GOTO(j); + } + a = CAR(sp->ap); + b = CAR(sp->bp); + exact = 1; + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + + case_HASHMAP_PHASE2_LOOP: + if (sp->ap && sp->bp) { + a = CAR(sp->ap); + b = CAR(sp->bp); + ASSERT(exact); + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_ARE_KEYS_EQUAL)); + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + } + goto case_HASHMAP_PHASE2_NEXT_STEP; + + case HASHMAP_PHASE2_ARE_KEYS_EQUAL: + sp = PSTACK_TOP(hmap_stack); + if (j == 0) { + /* keys are equal, skip them */ + sp->ap = hashmap_iterator_next(&stack); + sp->bp = hashmap_iterator_next(&b_stack); + goto case_HASHMAP_PHASE2_LOOP; + } + /* fall through */ + case_HASHMAP_PHASE2_NEXT_STEP: + if (sp->ap || sp->bp) { + if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) { + ASSERT(sp->ap); + a = CAR(sp->ap); + b = sp->min_key; + ASSERT(exact); + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_A)); + } + else { /* hash_cmp > 0 */ + ASSERT(sp->bp); + a = CAR(sp->bp); + b = sp->min_key; + ASSERT(exact); + WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_B)); + } + sp->wstack_rollback = WSTACK_COUNT(stack); + goto bodyrecur; + } + /* End of both maps */ + j = sp->cmp_res; + exact = sp->was_exact; + (void) PSTACK_POP(hmap_stack); + ON_CMP_GOTO(j); + + case HASHMAP_PHASE2_IS_MIN_KEY_A: + sp = PSTACK_TOP(hmap_stack); + if (j < 0) { + sp->min_key = CAR(sp->ap); + sp->cmp_res = -1; + } + sp->ap = hashmap_iterator_next(&stack); + goto case_HASHMAP_PHASE2_LOOP; + + case HASHMAP_PHASE2_IS_MIN_KEY_B: + sp = PSTACK_TOP(hmap_stack); + if (j < 0) { + sp->min_key = CAR(sp->bp); + sp->cmp_res = 1; + } + sp->bp = hashmap_iterator_next(&b_stack); + goto case_HASHMAP_PHASE2_LOOP; + + default: + ASSERT(!"Invalid cmp op"); + } /* switch */ } a = (Eterm) something; b = (Eterm) WSTACK_POP(stack); goto tailrecur; } - DESTROY_WSTACK(stack); + ASSERT(PSTACK_IS_EMPTY(hmap_stack)); + PSTACK_DESTROY(hmap_stack); + WSTACK_DESTROY(stack); + WSTACK_DESTROY(b_stack); return 0; not_equal: - DESTROY_WSTACK(stack); + if (!PSTACK_IS_EMPTY(hmap_stack) && !eq_only) { + WSTACK_ROLLBACK(stack, PSTACK_TOP(hmap_stack)->wstack_rollback); + goto pop_next; + } + PSTACK_DESTROY(hmap_stack); + WSTACK_DESTROY(stack); + WSTACK_DESTROY(b_stack); return j; #undef CMP_NODES @@ -3661,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; - res->timer.tm.active = 0; /* MUST be initalized */ - - 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; @@ -3809,9 +4452,7 @@ Uint tot_bin_allocated; void erts_init_utils(void) { -#ifdef ERTS_SMP - init_ptimers(); -#endif + } void erts_init_utils_mem(void) @@ -4351,8 +4992,8 @@ erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic) */ Uint64 erts_timestamp_millis(void) { -#ifdef HAVE_GETHRTIME - return (Uint64) (sys_gethrtime() / 1000000); +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + return ERTS_MONOTONIC_TO_MSEC(erts_os_monotonic_time()); #else Uint64 res; SysTimeval tv; diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index b62e9a0306..b2cfe70f94 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -264,23 +264,6 @@ dt_private *get_dt_private(int); -#define GET_TIME(i, b) \ - (i).year = get_int32((b) + 0 * 4); \ - (i).month = get_int32((b) + 1 * 4); \ - (i).day = get_int32((b) + 2 * 4); \ - (i).hour = get_int32((b) + 3 * 4); \ - (i).minute = get_int32((b) + 4 * 4); \ - (i).second = get_int32((b) + 5 * 4) - -#define PUT_TIME(i, b) \ - put_int32((i).year, (b) + 0 * 4); \ - put_int32((i).month, (b) + 1 * 4); \ - put_int32((i).day, (b) + 2 * 4); \ - put_int32((i).hour, (b) + 3 * 4); \ - put_int32((i).minute,(b) + 4 * 4); \ - put_int32((i).second,(b) + 5 * 4) - - #if ALWAYS_READ_LINE_AHEAD #define DEFAULT_LINEBUF_SIZE 2048 #else @@ -1633,12 +1616,12 @@ static void invoke_altname(void *data) } static void invoke_pwritev(void *data) { - struct t_data *d = (struct t_data *) data; + struct t_data* const d = (struct t_data *) data; + struct t_pwritev * const c = &d->c.pwritev; SysIOVec *iov0; SysIOVec *iov; int iovlen; int iovcnt; - struct t_pwritev *c = &d->c.pwritev; size_t p; int segment; size_t size, write_size, written; @@ -1712,9 +1695,9 @@ static void invoke_pwritev(void *data) { d->result_ok = 0; d->again = 0; deq_error: - MUTEX_LOCK(d->c.writev.q_mtx); - driver_deq(d->c.pwritev.port, c->size); - MUTEX_UNLOCK(d->c.writev.q_mtx); + MUTEX_LOCK(c->q_mtx); + driver_deq(c->port, c->size); + MUTEX_UNLOCK(c->q_mtx); goto done; } else { @@ -1725,9 +1708,9 @@ static void invoke_pwritev(void *data) { ASSERT(written >= FILE_SEGMENT_WRITE); } - MUTEX_LOCK(d->c.writev.q_mtx); - driver_deq(d->c.pwritev.port, written); - MUTEX_UNLOCK(d->c.writev.q_mtx); + MUTEX_LOCK(c->q_mtx); + driver_deq(c->port, written); + MUTEX_UNLOCK(c->q_mtx); done: EF_FREE(iov); /* Free our copy of the vector, nothing to restore */ @@ -1955,6 +1938,8 @@ static void invoke_sendfile(void *data) d->result_ok = 1; if (d->c.sendfile.nbytes != 0) d->c.sendfile.nbytes -= nbytes; + } else if (nbytes == 0 && d->c.sendfile.nbytes == 0) { + d->result_ok = 1; } else d->result_ok = 0; } else { diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 3143e4511d..f7b2d91d23 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -62,8 +62,17 @@ #define CRC32_COMBINE 23 #define ADLER32_COMBINE 24 +#define INFLATE_CHUNK 25 + + #define DEFAULT_BUFSZ 4000 +/* This flag is used in the same places, where zlib return codes + * (Z_OK, Z_STREAM_END, Z_NEED_DICT) are. So, we need to set it to + * relatively large value to avoid possible value clashes in future. + * */ +#define INFLATE_HAS_MORE 100 + static int zlib_init(void); static ErlDrvData zlib_start(ErlDrvPort port, char* buf); static void zlib_stop(ErlDrvData e); @@ -295,6 +304,58 @@ static int zlib_inflate(ZLibData* d, int flush) return res; } +static int zlib_inflate_chunk(ZLibData* d) +{ + int res = Z_OK; + + if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { + errno = ENOMEM; + return Z_ERRNO; + } + + while ((driver_sizeq(d->port) > 0) && (d->s.avail_out > 0) && + (res != Z_STREAM_END)) { + int vlen; + SysIOVec* iov = driver_peekq(d->port, &vlen); + int len; + + d->s.next_in = iov[0].iov_base; + d->s.avail_in = iov[0].iov_len; + while((d->s.avail_in > 0) && (d->s.avail_out > 0) && (res != Z_STREAM_END)) { + res = inflate(&d->s, Z_NO_FLUSH); + if (res == Z_NEED_DICT) { + /* Essential to eat the header bytes that zlib has looked at */ + len = iov[0].iov_len - d->s.avail_in; + driver_deq(d->port, len); + return res; + } + if (res == Z_BUF_ERROR) { + /* Was possible more output, but actually not */ + res = Z_OK; + } + else if (res < 0) { + return res; + } + } + len = iov[0].iov_len - d->s.avail_in; + driver_deq(d->port, len); + } + + /* We are here because all input was consumed or EOS reached or output + * buffer is full */ + if (d->want_crc) { + d->crc = crc32(d->crc, (unsigned char*) d->bin->orig_bytes, + d->binsz - d->s.avail_out); + } + zlib_output(d); + if ((res == Z_OK) && (d->s.avail_in > 0)) + res = INFLATE_HAS_MORE; + else if (res == Z_STREAM_END) { + d->inflate_eos_seen = 1; + } + return res; +} + static int zlib_deflate(ZLibData* d, int flush) { int res = Z_OK; @@ -568,6 +629,18 @@ static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *bu return zlib_return(res, rbuf, rlen); } + case INFLATE_CHUNK: + if (d->state != ST_INFLATE) goto badarg; + if (len != 0) goto badarg; + res = zlib_inflate_chunk(d); + if (res == INFLATE_HAS_MORE) { + return zlib_value2(4, 0, rbuf, rlen); + } else if (res == Z_NEED_DICT) { + return zlib_value2(3, d->s.adler, rbuf, rlen); + } else { + return zlib_return(res, rbuf, rlen); + } + case GET_QSIZE: return zlib_value(driver_sizeq(d->port), rbuf, rlen); diff --git a/erts/emulator/hipe/hipe_amd64_abi.txt b/erts/emulator/hipe/hipe_amd64_abi.txt index 8a34bfa67f..72aed13995 100644 --- a/erts/emulator/hipe/hipe_amd64_abi.txt +++ b/erts/emulator/hipe/hipe_amd64_abi.txt @@ -45,7 +45,7 @@ The first return value from a function is placed in %rax, the second (if any) is placed in %rdx. Notes: -- Currently, NR_ARG_REGS==0. +- Currently, NR_ARG_REGS == 4. - C BIFs expect P in C parameter register 1: %rdi. By making Erlang parameter registers 1-5 coincide with C parameter registers 2-6, our BIF wrappers can simply move P to %rdi without having to shift diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4 index b4b3c073ab..ca55d5bf3b 100644 --- a/erts/emulator/hipe/hipe_amd64_asm.m4 +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -253,6 +253,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(%rsi,3,0)` */' `/* #define NBIF_ARG_3_1 'NBIF_ARG(%rdx,3,1)` */' `/* #define NBIF_ARG_3_2 'NBIF_ARG(%rcx,3,2)` */' +`/* #define NBIF_ARG_4_0 'NBIF_ARG(%rsi,4,0)` */' +`/* #define NBIF_ARG_4_1 'NBIF_ARG(%rdx,4,1)` */' +`/* #define NBIF_ARG_4_2 'NBIF_ARG(%rcx,4,2)` */' +`/* #define NBIF_ARG_4_3 'NBIF_ARG(%r8,4,3)` */' `/* #define NBIF_ARG_5_0 'NBIF_ARG(%rsi,5,0)` */' `/* #define NBIF_ARG_5_1 'NBIF_ARG(%rdx,5,1)` */' `/* #define NBIF_ARG_5_2 'NBIF_ARG(%rcx,5,2)` */' @@ -277,6 +281,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)` */' `#endif /* ASM */' diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 7a4bb30447..74cb9112ce 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -51,9 +51,10 @@ 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_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, @@ -154,6 +155,42 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') +define(standard_bif_interface_4, +` +#ifndef HAVE_$1 +#`define' HAVE_$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 */ + 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, ` #ifndef HAVE_$1 diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index 955f7362b4..3cb0a2875b 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -321,6 +321,7 @@ ASYM(nbif_fail): GLOBAL(nbif_1_gc_after_bif) GLOBAL(nbif_2_gc_after_bif) GLOBAL(nbif_3_gc_after_bif) + GLOBAL(nbif_4_gc_after_bif) .align 4 nbif_0_gc_after_bif: xorl %edx, %edx @@ -336,6 +337,10 @@ nbif_2_gc_after_bif: .align 4 nbif_3_gc_after_bif: movl $3, %edx + jmp .gc_after_bif + .align 4 +nbif_4_gc_after_bif: + movl $4, %edx /*FALLTHROUGH*/ .align 4 .gc_after_bif: @@ -359,6 +364,7 @@ nbif_3_gc_after_bif: GLOBAL(nbif_1_simple_exception) GLOBAL(nbif_2_simple_exception) GLOBAL(nbif_3_simple_exception) + GLOBAL(nbif_4_simple_exception) .align 4 nbif_0_simple_exception: xorl %eax, %eax @@ -374,6 +380,10 @@ nbif_2_simple_exception: .align 4 nbif_3_simple_exception: movl $3, %eax + jmp .nbif_simple_exception + .align 4 +nbif_4_simple_exception: + movl $4, %eax /*FALLTHROUGH*/ .align 4 .nbif_simple_exception: 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 9e5830f345..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} @@ -1012,22 +1019,32 @@ static struct { * they create a new stub for the mfa, which forces locking. * XXX: Redesign apply et al to avoid those updates. */ - erts_smp_mtx_t lock; + erts_smp_rwmtx_t lock; } hipe_mfa_info_table; static inline void hipe_mfa_info_table_init_lock(void) { - erts_smp_mtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock"); + erts_smp_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock"); +} + +static inline void hipe_mfa_info_table_rlock(void) +{ + erts_smp_rwmtx_rlock(&hipe_mfa_info_table.lock); } -static inline void hipe_mfa_info_table_lock(void) +static inline void hipe_mfa_info_table_runlock(void) { - erts_smp_mtx_lock(&hipe_mfa_info_table.lock); + erts_smp_rwmtx_runlock(&hipe_mfa_info_table.lock); } -static inline void hipe_mfa_info_table_unlock(void) +static inline void hipe_mfa_info_table_rwlock(void) { - erts_smp_mtx_unlock(&hipe_mfa_info_table.lock); + erts_smp_rwmtx_rwlock(&hipe_mfa_info_table.lock); +} + +static inline void hipe_mfa_info_table_rwunlock(void) +{ + erts_smp_rwmtx_rwunlock(&hipe_mfa_info_table.lock); } #define HIPE_MFA_HASH(M,F,A) ((M) * (F) + (A)) @@ -1118,7 +1135,17 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter return NULL; } -static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity) +#if 0 /* XXX: unused */ +void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity) +{ + const struct hipe_mfa_info *p; + + p = hipe_mfa_info_table_get(m, f, arity); + return p ? p->address : NULL; +} +#endif + +static struct hipe_mfa_info *hipe_mfa_info_table_put_rwlocked(Eterm m, Eterm f, unsigned int arity) { unsigned long h; unsigned int i; @@ -1147,8 +1174,8 @@ static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address, { struct hipe_mfa_info *p; - hipe_mfa_info_table_lock(); - p = hipe_mfa_info_table_put_locked(m, f, arity); + hipe_mfa_info_table_rwlock(); + p = hipe_mfa_info_table_put_rwlocked(m, f, arity); #ifdef DEBUG_LINKER printf("%s: ", __FUNCTION__); print_mfa(m, f, arity); @@ -1157,7 +1184,7 @@ static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address, p->local_address = address; if (is_exported) p->remote_address = address; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); } #if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) @@ -1166,10 +1193,10 @@ void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int arity) struct hipe_mfa_info *p; void *trampoline; - hipe_mfa_info_table_lock(); - p = hipe_mfa_info_table_put_locked(m, f, arity); - trampoline = p->trampoline; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rlock(); + p = hipe_mfa_info_table_get_locked(m, f, arity); + trampoline = p ? p->trampoline : NULL; + hipe_mfa_info_table_runlock(); return trampoline; } @@ -1177,10 +1204,10 @@ void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int arity, void *trampol { struct hipe_mfa_info *p; - hipe_mfa_info_table_lock(); - p = hipe_mfa_info_table_put_locked(m, f, arity); + hipe_mfa_info_table_rwlock(); + p = hipe_mfa_info_table_put_rwlocked(m, f, arity); p->trampoline = trampoline; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); } #endif @@ -1211,7 +1238,7 @@ BIF_RETTYPE hipe_bifs_invalidate_funinfo_native_addresses_1(BIF_ALIST_1) struct mfa mfa; struct hipe_mfa_info *p; - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rwlock(); lst = BIF_ARG_1; while (is_list(lst)) { if (!term_to_mfa(CAR(list_val(lst)), &mfa)) @@ -1240,7 +1267,7 @@ BIF_RETTYPE hipe_bifs_invalidate_funinfo_native_addresses_1(BIF_ALIST_1) } } } - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); if (is_not_nil(lst)) BIF_ERROR(BIF_P, BADARG); BIF_RET(NIL); @@ -1254,8 +1281,8 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p orig_beam_op = pc[0]; if (orig_beam_op != BeamOpCode(op_hipe_trap_call_closure) && orig_beam_op != BeamOpCode(op_hipe_trap_call)) { - hipe_mfa_info_table_lock(); - p = hipe_mfa_info_table_put_locked(mod, fun, ari); + hipe_mfa_info_table_rwlock(); + p = hipe_mfa_info_table_put_rwlocked(mod, fun, ari); #ifdef DEBUG_LINKER printf("%s: ", __FUNCTION__); print_mfa(mod, fun, ari); @@ -1263,7 +1290,7 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p #endif p->beam_code = pc; p->orig_beam_op = orig_beam_op; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); } else { #ifdef DEBUG_LINKER printf("%s: ", __FUNCTION__); @@ -1287,7 +1314,7 @@ static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote) return StubAddress; } -static void *hipe_get_na_nofail_locked(Eterm m, Eterm f, unsigned int a, int is_remote) +static void *hipe_get_na_try_locked(Eterm m, Eterm f, unsigned int a, int is_remote, struct hipe_mfa_info **pp) { struct hipe_mfa_info *p; void *address; @@ -1305,22 +1332,53 @@ static void *hipe_get_na_nofail_locked(Eterm m, Eterm f, unsigned int a, int is_ address = p->remote_address; if (address) return address; - } else - p = hipe_mfa_info_table_put_locked(m, f, a); + } + /* Caller must take the slow path with the write lock held, but allow + it to avoid some work if it already holds the write lock. */ + if (pp) + *pp = p; + return NULL; +} + +static void *hipe_get_na_slow_rwlocked(Eterm m, Eterm f, unsigned int a, int is_remote, struct hipe_mfa_info *p) +{ + void *address; + + if (!p) + p = hipe_mfa_info_table_put_rwlocked(m, f, a); address = hipe_make_stub(m, f, a, is_remote); /* XXX: how to tell if a BEAM MFA is exported or not? */ p->remote_address = address; return address; } +static void *hipe_get_na_nofail_rwlocked(Eterm m, Eterm f, unsigned int a, int is_remote) +{ + struct hipe_mfa_info *p; + void *address; + + address = hipe_get_na_try_locked(m, f, a, is_remote, &p); + if (address) + return address; + + address = hipe_get_na_slow_rwlocked(m, f, a, is_remote, p); + return address; +} + static void *hipe_get_na_nofail(Eterm m, Eterm f, unsigned int a, int is_remote) { - void *p; + void *address; - hipe_mfa_info_table_lock(); - p = hipe_get_na_nofail_locked(m, f, a, is_remote); - hipe_mfa_info_table_unlock(); - return p; + hipe_mfa_info_table_rlock(); + address = hipe_get_na_try_locked(m, f, a, is_remote, NULL); + hipe_mfa_info_table_runlock(); + if (address) + return address; + + hipe_mfa_info_table_rwlock(); + address = hipe_get_na_slow_rwlocked(m, f, a, is_remote, NULL); + hipe_mfa_info_table_rwunlock(); + return address; } /* used for apply/3 in hipe_mode_switch */ @@ -1399,7 +1457,7 @@ int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a) /* Note about locking: the table is only updated from the loader, which runs with the rest of the system suspended. */ /* XXX: alas not true; see comment at hipe_mfa_info_table.lock */ - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rlock(); bucket = hipe_mfa_info_table.bucket; nrbuckets = 1 << hipe_mfa_info_table.log2size; mfa = NULL; @@ -1420,7 +1478,7 @@ int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a) *f = mfa->f; *a = mfa->a; } - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_runlock(); return mfa ? 1 : 0; } @@ -1497,9 +1555,9 @@ BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2) default: goto badarg; } - hipe_mfa_info_table_lock(); - callee_mfa = hipe_mfa_info_table_put_locked(callee.mod, callee.fun, callee.ari); - caller_mfa = hipe_mfa_info_table_put_locked(caller.mod, caller.fun, caller.ari); + hipe_mfa_info_table_rwlock(); + callee_mfa = hipe_mfa_info_table_put_rwlocked(callee.mod, callee.fun, callee.ari); + caller_mfa = hipe_mfa_info_table_put_rwlocked(caller.mod, caller.fun, caller.ari); refers_to = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*refers_to)); refers_to->mfa = callee_mfa; @@ -1513,7 +1571,7 @@ BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2) ref->flags = flags; ref->next = callee_mfa->referred_from; callee_mfa->referred_from = ref; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); BIF_RET(NIL); @@ -1533,12 +1591,12 @@ BIF_RETTYPE hipe_bifs_mark_referred_from_1(BIF_ALIST_1) /* get_refs_from */ if (!term_to_mfa(BIF_ARG_1, &mfa)) BIF_ERROR(BIF_P, BADARG); - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rwlock(); p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari); if (p) for (ref = p->referred_from; ref != NULL; ref = ref->next) ref->flags |= REF_FLAG_PENDING_REDIRECT; - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); BIF_RET(NIL); } @@ -1552,7 +1610,7 @@ static void hipe_purge_all_refs(void) struct hipe_mfa_info **bucket; unsigned int i, nrbuckets; - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rwlock(); bucket = hipe_mfa_info_table.bucket; nrbuckets = 1 << hipe_mfa_info_table.log2size; @@ -1574,7 +1632,7 @@ static void hipe_purge_all_refs(void) erts_free(ERTS_ALC_T_HIPE, mfa); } } - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); } BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) @@ -1591,7 +1649,7 @@ BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) if (!term_to_mfa(BIF_ARG_1, &mfa)) BIF_ERROR(BIF_P, BADARG); - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rwlock(); caller_mfa = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari); if (caller_mfa) { refers_to = caller_mfa->refers_to; @@ -1622,7 +1680,7 @@ BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) } caller_mfa->refers_to = NULL; } - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); BIF_RET(am_ok); } @@ -1641,7 +1699,7 @@ BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1) if (!term_to_mfa(BIF_ARG_1, &mfa)) BIF_ERROR(BIF_P, BADARG); - hipe_mfa_info_table_lock(); + hipe_mfa_info_table_rwlock(); p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari); if (p) { prev = &p->referred_from; @@ -1649,7 +1707,7 @@ BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1) while (ref) { if (ref->flags & REF_FLAG_PENDING_REDIRECT) { is_remote = ref->flags & REF_FLAG_IS_REMOTE; - new_address = hipe_get_na_nofail_locked(p->m, p->f, p->a, is_remote); + new_address = hipe_get_na_nofail_rwlocked(p->m, p->f, p->a, is_remote); if (ref->flags & REF_FLAG_IS_LOAD_MFA) res = hipe_patch_insn(ref->address, (Uint)new_address, am_load_mfa); else @@ -1672,7 +1730,7 @@ BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1) } } } - hipe_mfa_info_table_unlock(); + hipe_mfa_info_table_rwunlock(); BIF_RET(NIL); } 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_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 4a1caa1543..e5a56de687 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -280,6 +280,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(r3,3,0)` */' `/* #define NBIF_ARG_3_1 'NBIF_ARG(r3,3,1)` */' `/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */' +`/* #define NBIF_ARG_4_0 'NBIF_ARG(r3,4,0)` */' +`/* #define NBIF_ARG_4_1 'NBIF_ARG(r3,4,1)` */' +`/* #define NBIF_ARG_4_2 'NBIF_ARG(r3,4,2)` */' +`/* #define NBIF_ARG_4_3 'NBIF_ARG(r3,4,3)` */' `/* #define NBIF_ARG_5_0 'NBIF_ARG(r3,5,0)` */' `/* #define NBIF_ARG_5_1 'NBIF_ARG(r3,5,1)` */' `/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */' @@ -301,6 +305,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_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index f53b79b52e..b173b896b8 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -46,9 +46,10 @@ 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_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, @@ -144,6 +145,41 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') +define(standard_bif_interface_4, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,4,0) + NBIF_ARG(r5,4,1) + NBIF_ARG(r6,4,2) + NBIF_ARG(r7,4,3) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + STORE r4, P_ARG0(r3) /* Store BIF__ARGS in def_arg_reg[] */ + STORE r5, P_ARG1(r3) + STORE r6, P_ARG2(r3) + STORE r7, P_ARG3(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq- 1f + NBIF_RET(4) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_4_simple_exception) + HANDLE_GOT_MBUF(4) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + define(standard_bif_interface_0, ` #ifndef HAVE_$1 diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index c48fb150af..109289116b 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -462,10 +462,12 @@ ASYM(nbif_fail): OPD(nbif_1_gc_after_bif) OPD(nbif_2_gc_after_bif) OPD(nbif_3_gc_after_bif) + OPD(nbif_4_gc_after_bif) GLOBAL(CSYM(nbif_0_gc_after_bif)) GLOBAL(CSYM(nbif_1_gc_after_bif)) GLOBAL(CSYM(nbif_2_gc_after_bif)) GLOBAL(CSYM(nbif_3_gc_after_bif)) + GLOBAL(CSYM(nbif_4_gc_after_bif)) CSYM(nbif_0_gc_after_bif): li r4, 0 b .gc_after_bif @@ -477,6 +479,9 @@ CSYM(nbif_2_gc_after_bif): b .gc_after_bif CSYM(nbif_3_gc_after_bif): li r4, 3 + b .gc_after_bif +CSYM(nbif_4_gc_after_bif): + li r4, 4 /*FALLTHROUGH*/ .gc_after_bif: stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */ @@ -505,20 +510,29 @@ CSYM(nbif_3_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_4_simple_exception) + GLOBAL(CSYM(nbif_4_simple_exception)) +CSYM(nbif_4_simple_exception): + li r4, 4 /*FALLTHROUGH*/ .nbif_simple_exception: LOAD r3, P_FREASON(P) 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_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 index c3c3bcb74a..8020104e40 100644 --- a/erts/emulator/hipe/hipe_sparc_asm.m4 +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -176,6 +176,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(r3,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)` */' @@ -200,6 +204,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_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 2bfe3a4646..1d0ff8c16e 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -54,9 +54,10 @@ 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_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, @@ -146,6 +147,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 P, %o0 + NBIF_ARG(%o1,4,0) + NBIF_ARG(%o2,4,1) + NBIF_ARG(%o3,4,2) + NBIF_ARG(%o4,4,3) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + st %o3, [%o0+P_ARG2] + st %o4, [%o0+P_ARG3] + add %o0, P_ARG0, %o1 + CALL_BIF($2) + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(4) + RESTORE_CONTEXT_BIF + NBIF_RET(4) + HANDLE_GOT_MBUF(4) + .size $1, .-$1 + .type $1, #function +#endif') + define(standard_bif_interface_0, ` #ifndef HAVE_$1 diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index 6c8c841194..094a87fd58 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -316,6 +316,7 @@ nbif_fail: .global nbif_1_gc_after_bif .global nbif_2_gc_after_bif .global nbif_3_gc_after_bif + .global nbif_4_gc_after_bif nbif_0_gc_after_bif: ba .gc_after_bif mov 0, %o1 /* delay slot */ @@ -326,7 +327,10 @@ nbif_2_gc_after_bif: ba .gc_after_bif mov 2, %o1 /* delay slot */ nbif_3_gc_after_bif: - mov 3, %o1 + ba .gc_after_bif + mov 3, %o1 /* delay slot */ +nbif_4_gc_after_bif: + mov 4, %o1 /*FALLTHROUGH*/ .gc_after_bif: st %o1, [P+P_NARITY] @@ -364,7 +368,11 @@ nbif_2_simple_exception: mov 2, %o1 /* delay slot */ .global nbif_3_simple_exception nbif_3_simple_exception: - mov 3, %o1 + ba .nbif_simple_exception + mov 3, %o1 /* delay slot */ + .global nbif_4_simple_exception +nbif_4_simple_exception: + mov 4, %o1 /*FALLTHROUGH*/ .nbif_simple_exception: ld [P+P_FREASON], %o0 diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 index 39c5cb1044..436feca506 100644 --- a/erts/emulator/hipe/hipe_x86_asm.m4 +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -212,6 +212,7 @@ define(NBIF_COPY_NSP,`ifelse(eval($1 > NR_ARG_REGS),0,,`movl %esp, TEMP_NSP')')d `/* #define NBIF_COPY_NSP_1 'NBIF_COPY_NSP(1)` */' `/* #define NBIF_COPY_NSP_2 'NBIF_COPY_NSP(2)` */' `/* #define NBIF_COPY_NSP_3 'NBIF_COPY_NSP(3)` */' +`/* #define NBIF_COPY_NSP_4 'NBIF_COPY_NSP(4)` */' `/* #define NBIF_COPY_NSP_5 'NBIF_COPY_NSP(5)` */' dnl @@ -235,6 +236,10 @@ define(NBIF_ARG_OPND,`ifelse(eval($2 >= NR_ARG_REGS),0,`ARG'$2,BASE_OFFSET(eval( `/* #define NBIF_ARG_OPND_3_0 'NBIF_ARG_OPND(3,0)` */' `/* #define NBIF_ARG_OPND_3_1 'NBIF_ARG_OPND(3,1)` */' `/* #define NBIF_ARG_OPND_3_2 'NBIF_ARG_OPND(3,2)` */' +`/* #define NBIF_ARG_OPND_4_0 'NBIF_ARG_OPND(4,0)` */' +`/* #define NBIF_ARG_OPND_4_1 'NBIF_ARG_OPND(4,1)` */' +`/* #define NBIF_ARG_OPND_4_2 'NBIF_ARG_OPND(4,2)` */' +`/* #define NBIF_ARG_OPND_4_3 'NBIF_ARG_OPND(4,3)` */' `/* #define NBIF_ARG_OPND_5_0 'NBIF_ARG_OPND(5,0)` */' `/* #define NBIF_ARG_OPND_5_1 'NBIF_ARG_OPND(5,1)` */' `/* #define NBIF_ARG_OPND_5_2 'NBIF_ARG_OPND(5,2)` */' @@ -274,6 +279,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_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index a0f16efa33..bf549c90e4 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -48,9 +48,10 @@ 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_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, @@ -158,6 +159,43 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') +define(standard_bif_interface_4, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(4) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(2,4,0) + NBIF_ARG(3,4,1) + NBIF_ARG(4,4,2) + NBIF_ARG(5,4,3) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) /* BIF__ARGS */ + CALL_BIF($2) + TEST_GOT_MBUF + + /* switch to native stack */ + 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, ` #ifndef HAVE_$1 diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index 9d38eaaafd..f124e36a26 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -299,6 +299,7 @@ ASYM(nbif_fail): GLOBAL(nbif_1_gc_after_bif) GLOBAL(nbif_2_gc_after_bif) GLOBAL(nbif_3_gc_after_bif) + GLOBAL(nbif_4_gc_after_bif) .align 4 nbif_0_gc_after_bif: xorl %edx, %edx @@ -314,6 +315,10 @@ nbif_2_gc_after_bif: .align 4 nbif_3_gc_after_bif: movl $3, %edx + jmp .gc_after_bif + .align 4 +nbif_4_gc_after_bif: + movl $4, %edx /*FALLTHROUGH*/ .align 4 .gc_after_bif: @@ -337,6 +342,7 @@ nbif_3_gc_after_bif: GLOBAL(nbif_1_simple_exception) GLOBAL(nbif_2_simple_exception) GLOBAL(nbif_3_simple_exception) + GLOBAL(nbif_4_simple_exception) .align 4 nbif_0_simple_exception: xorl %eax, %eax @@ -352,6 +358,10 @@ nbif_2_simple_exception: .align 4 nbif_3_simple_exception: movl $3, %eax + jmp .nbif_simple_exception + .align 4 +nbif_4_simple_exception: + movl $4, %eax /*FALLTHROUGH*/ .align 4 .nbif_simple_exception: diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 0051b45b31..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 @@ -1590,9 +1592,9 @@ ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set) void ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set, - erts_short_time_t msec) + ErtsMonotonicTime timeout_time) { - ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, msec); + ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, timeout_time); } void @@ -1600,9 +1602,12 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) { ErtsPollResFd *pollres; int pollres_len; - SysTimeval wait_time; + ErtsMonotonicTime timeout_time; int poll_ret, i; erts_aint_t current_cio_time; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + + ASSERT(esdp); restart: @@ -1612,12 +1617,9 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) #endif /* Figure out timeout value */ - if (do_wait) { - erts_time_remaining(&wait_time); - } else { /* poll only */ - wait_time.tv_sec = 0; - wait_time.tv_usec = 0; - } + timeout_time = (do_wait + ? erts_check_next_timeout_time(esdp) + : ERTS_POLL_NO_TIMEOUT /* poll only */); /* * No need for an atomic inc op when incrementing @@ -1640,14 +1642,12 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1); - poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, &wait_time); + poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, timeout_time); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); /* No locks should be locked */ #endif - erts_deliver_time(); /* sync the machine's idea of time */ - #ifdef ERTS_BREAK_REQUESTED if (ERTS_BREAK_REQUESTED) erts_do_break_handling(); diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index d01297d55c..71355965aa 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -47,8 +47,8 @@ void erts_check_io_async_sig_interrupt_nkp(void); #endif void erts_check_io_interrupt_kp(int); void erts_check_io_interrupt_nkp(int); -void erts_check_io_interrupt_timed_kp(int, erts_short_time_t); -void erts_check_io_interrupt_timed_nkp(int, erts_short_time_t); +void erts_check_io_interrupt_timed_kp(int, ErtsMonotonicTime); +void erts_check_io_interrupt_timed_nkp(int, ErtsMonotonicTime); void erts_check_io_kp(int); void erts_check_io_nkp(int); void erts_init_check_io_kp(void); @@ -65,7 +65,7 @@ int erts_check_io_max_files(void); void erts_check_io_async_sig_interrupt(void); #endif void erts_check_io_interrupt(int); -void erts_check_io_interrupt_timed(int, erts_short_time_t); +void erts_check_io_interrupt_timed(int, ErtsMonotonicTime); void erts_check_io(int); void erts_init_check_io(void); diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c new file mode 100644 index 0000000000..f3633b7267 --- /dev/null +++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c @@ -0,0 +1,88 @@ +/* + * %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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "erl_os_monotonic_time_extender.h" + +#ifdef USE_THREADS + +static void *os_monotonic_time_extender(void *vstatep) +{ + ErtsOsMonotonicTimeExtendState *state = (ErtsOsMonotonicTimeExtendState *) vstatep; + long sleep_time = state->check_interval*1000; + Uint32 (*raw_os_mtime)(void) = state->raw_os_monotonic_time; + Uint32 last_msb = 0; + + while (1) { + Uint32 msb = (*raw_os_mtime)() & (((Uint32) 1) << 31); + + if (msb != last_msb) { + int ix = ((int) (last_msb >> 31)) & 1; + Uint32 xtnd = (Uint32) erts_atomic32_read_nob(&state->extend[ix]); + erts_atomic32_set_nob(&state->extend[ix], (erts_aint32_t) (xtnd + 1)); + last_msb = msb; + } + erts_milli_sleep(sleep_time); + } + + erl_exit(ERTS_ABORT_EXIT, "os_monotonic_time_extender thread terminating"); + return NULL; +} + +static erts_tid_t os_monotonic_extender_tid; +#endif + +void +erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep, + Uint32 (*raw_os_monotonic_time)(void), + int check_seconds) +{ +#ifdef USE_THREADS + statep->raw_os_monotonic_time = raw_os_monotonic_time; + erts_atomic32_init_nob(&statep->extend[0], (erts_aint32_t) 0); + erts_atomic32_init_nob(&statep->extend[1], (erts_aint32_t) 0); + statep->check_interval = check_seconds; + +#else + statep->extend[0] = (Uint32) 0; + statep->extend[1] = (Uint32) 0; + statep->last_msb = (ErtsMonotonicTime) 0; +#endif +} + +void +erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep) +{ +#ifdef USE_THREADS + erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 1; + thr_opts.suggested_stack_size = 4; + +#if 0 + thr_opts.name = "os_monotonic_time_extender"; +#endif + + erts_thr_create(&os_monotonic_extender_tid, + os_monotonic_time_extender, + (void*) statep, + &thr_opts); +#endif +} diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.h b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h new file mode 100644 index 0000000000..0f9e7c86ae --- /dev/null +++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h @@ -0,0 +1,65 @@ +/* + * %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_OS_MONOTONIC_TIME_EXTENDER_H__ +#define ERL_OS_MONOTONIC_TIME_EXTENDER_H__ + +#include "sys.h" +#include "erl_threads.h" + +typedef struct { +#ifdef USE_THREADS + Uint32 (*raw_os_monotonic_time)(void); + erts_atomic32_t extend[2]; + int check_interval; +#else + Uint32 extend[2]; + ErtsMonotonicTime last_msb; +#endif +} ErtsOsMonotonicTimeExtendState; + +#ifdef USE_THREADS +# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) ((void) 1) +# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \ + ((((ErtsMonotonicTime) \ + erts_atomic32_read_nob(&((S)->extend[((int) ((RT) >> 31)) & 1]))) \ + << 32) \ + + (RT)) +#else +# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) \ + do { \ + Uint32 msb__ = (RT) & (((Uint32) 1) << 31); \ + if (msb__ != (S)->last_msb) { \ + int ix__ = ((int) ((S)->last_msb >> 31)) & 1; \ + (S)->extend[ix__]++; \ + (S)->last_msb = msb; \ + } \ + } while (0) +# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \ + ((((ErtsMonotonicTime) (S)->extend[((int) ((RT) >> 31)) & 1]) << 32) + (RT)) +#endif + +void +erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep, + Uint32 (*raw_os_monotonic_time)(void), + int check_seconds); +void +erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep); + +#endif diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index aa412a20c8..446cca77ff 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -320,7 +320,7 @@ struct ErtsPollSet_ { #if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT erts_atomic32_t wakeup_state; #endif - erts_smp_atomic32_t timeout; + erts_atomic64_t timeout_time; #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_t no_avoided_wakeups; erts_smp_atomic_t no_avoided_interrupts; @@ -384,6 +384,26 @@ static void check_poll_status(ErtsPollSet ps); static void print_misc_debug_info(void); #endif +static ERTS_INLINE void +init_timeout_time(ErtsPollSet ps) +{ + erts_atomic64_init_nob(&ps->timeout_time, + (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX); +} + +static ERTS_INLINE void +set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time) +{ + erts_atomic64_set_relb(&ps->timeout_time, + (erts_aint64_t) time); +} + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_time(ErtsPollSet ps) +{ + return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time); +} + #define ERTS_POLL_NOT_WOKEN 0 #define ERTS_POLL_WOKEN -1 #define ERTS_POLL_WOKEN_INTR 1 @@ -1993,44 +2013,153 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, } } +static ERTS_INLINE ErtsMonotonicTime +get_timeout(ErtsPollSet ps, + int resolution, + ErtsMonotonicTime timeout_time) +{ + ErtsMonotonicTime timeout, save_timeout_time; + + if (timeout_time == ERTS_POLL_NO_TIMEOUT) { + save_timeout_time = ERTS_MONOTONIC_TIME_MIN; + timeout = 0; + } + else { + ErtsMonotonicTime diff_time, current_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; + timeout = 0; + } + else { + save_timeout_time = current_time; + switch (resolution) { + case 1000: + /* Round up to nearest even milli second */ + timeout = ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1; + if (timeout > (ErtsMonotonicTime) INT_MAX) + timeout = (ErtsMonotonicTime) INT_MAX; + save_timeout_time += ERTS_MSEC_TO_MONOTONIC(timeout); + break; + case 1000000: + /* Round up to nearest even micro second */ + timeout = ERTS_MONOTONIC_TO_USEC(diff_time - 1) + 1; + save_timeout_time += ERTS_USEC_TO_MONOTONIC(timeout); + break; + case 1000000000: + /* Round up to nearest even nano second */ + timeout = ERTS_MONOTONIC_TO_NSEC(diff_time - 1) + 1; + save_timeout_time += ERTS_NSEC_TO_MONOTONIC(timeout); + break; + default: + ERTS_INTERNAL_ERROR("Invalid resolution"); + timeout = 0; + save_timeout_time = 0; + break; + } + } + } + set_timeout_time(ps, save_timeout_time); + return timeout; +} + +#if ERTS_POLL_USE_SELECT + static ERTS_INLINE int -check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) +get_timeout_timeval(ErtsPollSet ps, + SysTimeval *tvp, + ErtsMonotonicTime timeout_time) +{ + ErtsMonotonicTime timeout = get_timeout(ps, + 1000*1000, + timeout_time); + + if (!timeout) { + tvp->tv_sec = 0; + tvp->tv_usec = 0; + + return 0; + } + else { + ErtsMonotonicTime sec = timeout/(1000*1000); + tvp->tv_sec = sec; + tvp->tv_usec = timeout - sec*(1000*1000); + + ASSERT(tvp->tv_sec >= 0); + ASSERT(tvp->tv_usec >= 0); + ASSERT(tvp->tv_usec < 1000*1000); + + return !0; + } + +} + +#endif + +#if ERTS_POLL_USE_KQUEUE + +static ERTS_INLINE int +get_timeout_timespec(ErtsPollSet ps, + struct timespec *tsp, + ErtsMonotonicTime timeout_time) +{ + ErtsMonotonicTime timeout = get_timeout(ps, + 1000*1000*1000, + timeout_time); + + if (!timeout) { + tsp->tv_sec = 0; + tsp->tv_nsec = 0; + return 0; + } + else { + ErtsMonotonicTime sec = timeout/(1000*1000*1000); + tsp->tv_sec = sec; + tsp->tv_nsec = timeout - sec*(1000*1000*1000); + + ASSERT(tsp->tv_sec >= 0); + ASSERT(tsp->tv_nsec >= 0); + ASSERT(tsp->tv_nsec < 1000*1000); + + return !0; + } +} + +#endif + +static ERTS_INLINE int +check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) { int res; if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0 - && tv->tv_usec == 0 && tv->tv_sec == 0) { + && timeout_time == ERTS_POLL_NO_TIMEOUT) { /* Nothing to poll and zero timeout; done... */ return 0; } else { - long timeout = tv->tv_sec*1000 + tv->tv_usec/1000; - if (timeout > ERTS_AINT32_T_MAX) - timeout = ERTS_AINT32_T_MAX; - ASSERT(timeout >= 0); - erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); + int timeout; #if ERTS_POLL_USE_FALLBACK if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) { #if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ - if (timeout > INT_MAX) - timeout = INT_MAX; if (max_res > ps->res_events_len) grow_res_events(ps, max_res); + timeout = (int) get_timeout(ps, 1000, timeout_time); #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); #endif - res = epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout); + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ struct timespec ts; if (max_res > ps->res_events_len) grow_res_events(ps, max_res); + timeout = get_timeout_timespec(ps, &ts, timeout_time); #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); #endif - ts.tv_sec = tv->tv_sec; - ts.tv_nsec = tv->tv_usec*1000; res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); #endif /* ----------------------------------------- */ } @@ -2049,8 +2178,7 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) #if ERTS_POLL_USE_WAKEUP_PIPE nfds++; /* Wakeup pipe */ #endif - if (timeout > INT_MAX) - timeout = INT_MAX; + timeout = (int) get_timeout(ps, 1000, timeout_time); poll_res.dp_nfds = nfds < max_res ? nfds : max_res; if (poll_res.dp_nfds > ps->res_events_len) grow_res_events(ps, poll_res.dp_nfds); @@ -2059,33 +2187,33 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) if (timeout) erts_thr_progress_prepare_wait(NULL); #endif - poll_res.dp_timeout = (int) timeout; + poll_res.dp_timeout = timeout; res = ioctl(ps->kp_fd, DP_POLL, &poll_res); #elif ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ - if (timeout > INT_MAX) - timeout = INT_MAX; + timeout = (int) get_timeout(ps, 1000, timeout_time); #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); #endif - res = poll(ps->poll_fds, ps->no_poll_fds, (int) timeout); + res = poll(ps->poll_fds, ps->no_poll_fds, timeout); #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ - SysTimeval to = *tv; + SysTimeval to; + timeout = get_timeout_timeval(ps, &to, timeout_time); ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds); ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds); #ifdef ERTS_SMP - if (to.tv_sec || to.tv_usec) + if (timeout) erts_thr_progress_prepare_wait(NULL); #endif res = ERTS_SELECT(ps->max_fd + 1, - &ps->res_input_fds, - &ps->res_output_fds, - NULL, - &to); + &ps->res_input_fds, + &ps->res_output_fds, + NULL, + &to); #ifdef ERTS_SMP - if (to.tv_sec || to.tv_usec) + if (timeout) erts_thr_progress_finalize_wait(NULL); if (res < 0 && errno == EBADF @@ -2108,10 +2236,10 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) handle_update_requests(ps); ERTS_POLLSET_UNLOCK(ps); res = ERTS_SELECT(ps->max_fd + 1, - &ps->res_input_fds, - &ps->res_output_fds, - NULL, - &to); + &ps->res_input_fds, + &ps->res_output_fds, + NULL, + &to); if (res == 0) { errno = EAGAIN; res = -1; @@ -2133,15 +2261,14 @@ int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, ErtsPollResFd pr[], int *len, - SysTimeval *utvp) + ErtsMonotonicTime timeout_time) { + ErtsMonotonicTime to; int res, no_fds; int ebadf = 0; #ifdef ERTS_SMP int ps_locked = 0; #endif - SysTimeval *tvp; - SysTimeval itv; no_fds = *len; #ifdef ERTS_POLL_MAX_RES @@ -2151,13 +2278,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, *len = 0; - ASSERT(utvp); - - tvp = utvp; - #ifdef ERTS_POLL_DEBUG_PRINT - erts_printf("Entering erts_poll_wait(), timeout=%d\n", - (int) tvp->tv_sec*1000 + tvp->tv_usec/1000); + erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n", + timeout_time); #endif if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { @@ -2166,12 +2289,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, goto done; } - if (is_woken(ps)) { - /* Use zero timeout */ - itv.tv_sec = 0; - itv.tv_usec = 0; - tvp = &itv; - } + to = (is_woken(ps) + ? ERTS_POLL_NO_TIMEOUT /* Use zero timeout */ + : timeout_time); #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE if (ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { @@ -2181,7 +2301,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, } #endif - res = check_fd_events(ps, tvp, no_fds); + res = check_fd_events(ps, to, no_fds); woke_up(ps); @@ -2224,7 +2344,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #endif done: - erts_smp_atomic32_set_relb(&ps->timeout, ERTS_AINT32_T_MAX); + set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX); #ifdef ERTS_POLL_DEBUG_PRINT erts_printf("Leaving %s = erts_poll_wait()\n", res == 0 ? "0" : erl_errno_id(res)); @@ -2268,13 +2388,14 @@ ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps) void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, int set, - erts_short_time_t msec) + ErtsMonotonicTime timeout_time) { #if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) if (!set) reset_wakeup_state(ps); else { - if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + ErtsMonotonicTime max_wait_time = get_timeout_time(ps); + if (max_wait_time > timeout_time) wake_poller(ps, 1, 0); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS else { @@ -2431,7 +2552,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) ps->internal_fd_limit = kp_fd + 1; ps->kp_fd = kp_fd; #endif - erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX); + init_timeout_time(ps); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_init_nob(&ps->no_avoided_wakeups, 0); erts_smp_atomic_init_nob(&ps->no_avoided_interrupts, 0); diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 2f1c05f401..d02ed2396b 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -29,6 +29,8 @@ #include "sys.h" +#define ERTS_POLL_NO_TIMEOUT ERTS_MONOTONIC_TIME_MIN + #if 0 #define ERTS_POLL_COUNT_AVOIDED_WAKEUPS #endif @@ -241,7 +243,7 @@ void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet, int); void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet, int, - erts_short_time_t); + ErtsMonotonicTime); ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet, ErtsSysFdType, ErtsPollEvents, @@ -254,7 +256,7 @@ void ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet, int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet, ErtsPollResFd [], int *, - SysTimeval *); + ErtsMonotonicTime); int ERTS_POLL_EXPORT(erts_poll_max_fds)(void); void ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet, ErtsPollInfo *); diff --git a/erts/emulator/sys/ose/erl_ose_sys.h b/erts/emulator/sys/ose/erl_ose_sys.h index cd66d95c26..f6526a4714 100644 --- a/erts/emulator/sys/ose/erl_ose_sys.h +++ b/erts/emulator/sys/ose/erl_ose_sys.h @@ -112,6 +112,8 @@ extern clock_t sys_times(SysTimes *buffer); /* No use in having other resolutions than 1 Ms. */ #define SYS_CLOCK_RESOLUTION 1 +#define erts_isfinite finite + #ifdef NO_FPE_SIGNALS #define erts_get_current_fp_exception() NULL diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c index 7d2a3d1e0b..3d4ac0365f 100644 --- a/erts/emulator/sys/ose/erl_poll.c +++ b/erts/emulator/sys/ose/erl_poll.c @@ -114,7 +114,7 @@ struct ErtsPollSet_ { Uint item_count; PROCESS interrupt; erts_atomic32_t wakeup_state; - erts_smp_atomic32_t timeout; + erts_atomic64_t timeout_time; #ifdef ERTS_SMP erts_smp_mtx_t mtx; #endif @@ -122,6 +122,26 @@ struct ErtsPollSet_ { static int max_fds = -1; +static ERTS_INLINE void +init_timeout_time(ErtsPollSet ps) +{ + erts_atomic64_init_nob(&ps->timeout_time, + (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX); +} + +static ERTS_INLINE void +set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time) +{ + erts_atomic64_set_relb(&ps->timeout_time, + (erts_aint64_t) time); +} + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_time(ErtsPollSet ps) +{ + return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time); +} + #define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) (1 << 0)) #define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) (1 << 1)) #define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) (1 << 2)) @@ -386,12 +406,14 @@ void erts_poll_interrupt(ErtsPollSet ps,int set) { } -void erts_poll_interrupt_timed(ErtsPollSet ps,int set,erts_short_time_t msec) { +void erts_poll_interrupt_timed(ErtsPollSet ps, + int set, + ErtsTimeoutTime timeout_time) { HARDTRACEF("erts_poll_interrupt_timed called!\n"); if (!set) reset_interrupt(ps); - else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + else if (get_timeout_time(ps) > timeout_time) set_interrupt(ps); } @@ -453,12 +475,14 @@ done: } int erts_poll_wait(ErtsPollSet ps, - ErtsPollResFd pr[], - int *len, - SysTimeval *utvp) { + ErtsPollResFd pr[], + int *len, + ErtsMonotonicTime timeout_time) +{ int res = ETIMEDOUT, no_fds, currid = 0; OSTIME timeout; union SIGNAL *sig; + ErtsMonotonicTime current_time, diff_time, timeout; // HARDTRACEF("%ux: In erts_poll_wait",ps); if (ps->interrupt == (PROCESS)0) ps->interrupt = current_process(); @@ -472,16 +496,29 @@ int erts_poll_wait(ErtsPollSet ps, *len = 0; - ASSERT(utvp); + /* erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n", + timeout_time); */ - /* erts_printf("Entering erts_poll_wait(), timeout=%d\n", - (int) utvp->tv_sec*1000 + utvp->tv_usec/1000); */ - - timeout = utvp->tv_sec*1000 + utvp->tv_usec/1000; + if (timeout_time == ERTS_POLL_NO_TIMEOUT) { + no_timeout: + timeout = (OSTIME) 0; + save_timeout_time = ERTS_MONOTONIC_TIME_MIN; + } + else { + ErtsMonotonicTime current_time, diff_time; + current_time = erts_get_monotonic_time(NULL); + diff_time = timeout_time - current_time; + if (diff_time <= 0) + goto no_timeout; + diff_time = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1); + if (diff_time > INT_MAX) + diff_time = INT_MAX; + timeout = (OSTIME) diff_time; + save_timeout_time = current_time; + save_timeout_time += ERTS_MSEC_TO_MONOTONIC(diff_time); + } - if (timeout > ((time_t) ERTS_AINT32_T_MAX)) - timeout = ERTS_AINT32_T_MAX; - erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); + set_timeout_time(ps, save_timeout_time); while (currid < no_fds) { if (timeout > 0) { @@ -627,7 +664,7 @@ int erts_poll_wait(ErtsPollSet ps, } erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); - erts_smp_atomic32_set_nob(&ps->timeout, ERTS_AINT32_T_MAX); + set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX); *len = currid; @@ -690,7 +727,7 @@ ErtsPollSet erts_poll_create_pollset(void) ps->info = NULL; ps->interrupt = (PROCESS)0; erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); - erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX); + init_timeout_time(ps); #ifdef ERTS_SMP erts_smp_mtx_init(&ps->mtx, "pollset"); #endif diff --git a/erts/emulator/sys/ose/sys.c b/erts/emulator/sys/ose/sys.c index 5b950a7dae..13a5b71496 100644 --- a/erts/emulator/sys/ose/sys.c +++ b/erts/emulator/sys/ose/sys.c @@ -298,9 +298,9 @@ erts_sys_schedule_interrupt(int set) #ifdef ERTS_SMP void -erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) +erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time) { - ERTS_CHK_IO_INTR_TMD(set, msec); + ERTS_CHK_IO_INTR_TMD(set, timeout_time); } #endif diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index f0050db114..1942b631fc 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -114,11 +114,6 @@ /* * Make sure that MAXPATHLEN is defined. */ -#ifdef GETHRTIME_WITH_CLOCK_GETTIME -#undef HAVE_GETHRTIME -#define HAVE_GETHRTIME 1 -#endif - #ifndef MAXPATHLEN # ifdef PATH_MAX # define MAXPATHLEN PATH_MAX @@ -160,33 +155,132 @@ typedef struct timeval SysTimeval; typedef struct tms SysTimes; -extern int erts_ticks_per_sec; - -#define SYS_CLK_TCK (erts_ticks_per_sec) +#define SYS_CLK_TCK (erts_sys_time_data__.r.o.ticks_per_sec) #define sys_times(Arg) times(Arg) -#define ERTS_WRAP_SYS_TIMES 1 -extern int erts_ticks_per_sec_wrap; -#define SYS_CLK_TCK_WRAP (erts_ticks_per_sec_wrap) -extern clock_t sys_times_wrap(void); +#if SIZEOF_LONG == 8 +typedef long ErtsMonotonicTime; +typedef long ErtsSysHrTime; +#elif SIZEOF_LONG_LONG == 8 +typedef long long ErtsMonotonicTime; +typedef long long ErtsSysHrTime; +#else +#error No signed 64-bit type found... +#endif + +typedef ErtsMonotonicTime ErtsSystemTime; + +#define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63) +#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN) + +/* + * OS monotonic time and OS system time + */ +#undef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ + +#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 +#endif -#ifdef HAVE_GETHRTIME -#ifdef GETHRTIME_WITH_CLOCK_GETTIME -typedef long long SysHrTime; +ErtsSystemTime erts_os_system_time(void); -extern SysHrTime sys_gethrtime(void); -#define sys_init_hrtime() /* Nothing */ +#undef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT +#undef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT +#undef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ -#else /* Real gethrtime (Solaris) */ +#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_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ 1 +# endif +#elif defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) +# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1 +# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000) +#elif defined(OS_MONOTONIC_TIME_USING_GETHRTIME) +# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1 +# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000) +#elif defined(OS_MONOTONIC_TIME_USING_TIMES) +# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1 +/* Time unit determined at runtime... */ +# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT 0 +#else /* No OS monotonic available... */ +# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000) +#endif -typedef hrtime_t SysHrTime; +/* + * erts_sys_hrtime() is the highest resolution + * time function found. Time unit is nano-seconds. + * It may or may not be monotonic. + */ +ErtsSysHrTime erts_sys_hrtime(void); -#define sys_gethrtime() gethrtime() -#define sys_init_hrtime() /* Nothing */ +struct erts_sys_time_read_only_data__ { +#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ + ErtsMonotonicTime (*os_monotonic_time)(void); +#endif +#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ + void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *); +#endif + int ticks_per_sec; +}; + +typedef struct { + union { + struct erts_sys_time_read_only_data__ o; + char align__[(((sizeof(struct erts_sys_time_read_only_data__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } r; +} ErtsSysTimeData__; -#endif /* GETHRTIME_WITH_CLOCK_GETTIME */ -#endif /* HAVE_GETHRTIME */ +extern ErtsSysTimeData__ erts_sys_time_data__; + +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT + +#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ +ERTS_GLB_INLINE +#endif +ErtsMonotonicTime erts_os_monotonic_time(void); + +#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ +ERTS_GLB_INLINE +#endif +void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ + +ERTS_GLB_INLINE ErtsMonotonicTime +erts_os_monotonic_time(void) +{ + return (*erts_sys_time_data__.r.o.os_monotonic_time)(); +} + +#endif /* ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ */ + +#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ + +ERTS_GLB_INLINE void +erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + return (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); +} + +#endif /* ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ */ + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */ + +/* + * + */ #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) typedef long long SysCpuTime; @@ -242,6 +336,8 @@ extern void sys_stop_cat(void); # define HAVE_ISFINITE #endif +#define erts_isfinite isfinite + #ifdef NO_FPE_SIGNALS #define erts_get_current_fp_exception() NULL diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 0d9c743c0c..7d52650a70 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -308,7 +308,7 @@ struct { int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); void (*check_io_as_interrupt)(void); void (*check_io_interrupt)(int); - void (*check_io_interrupt_tmd)(int, erts_short_time_t); + void (*check_io_interrupt_tmd)(int, ErtsMonotonicTime); void (*check_io)(int); Uint (*size)(void); Eterm (*info)(void *); @@ -414,9 +414,9 @@ erts_sys_schedule_interrupt(int set) #ifdef ERTS_SMP void -erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) +erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time) { - ERTS_CHK_IO_INTR_TMD(set, msec); + ERTS_CHK_IO_INTR_TMD(set, timeout_time); } #endif @@ -532,11 +532,14 @@ thr_create_prepare_child(void *vtcdp) void erts_sys_pre_init(void) { +#ifdef USE_THREADS + erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; +#endif + erts_printf_add_cr_to_stdout = 1; erts_printf_add_cr_to_stderr = 1; + #ifdef USE_THREADS - { - erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; eid.thread_create_child_func = thr_create_prepare_child; /* Before creation in parent */ @@ -559,6 +562,12 @@ erts_sys_pre_init(void) erts_lcnt_init(); #endif +#endif /* USE_THREADS */ + + erts_init_sys_time_sup(); + +#ifdef USE_THREADS + #if CHLDWTHR || defined(ERTS_SMP) erts_mtx_init(&chld_stat_mtx, "child_status"); #endif @@ -569,7 +578,7 @@ erts_sys_pre_init(void) erts_cnd_init(&chld_stat_cnd); children_alive = 0; #endif - } + #ifdef ERTS_SMP erts_smp_atomic32_init_nob(&erts_break_requested, 0); erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0); @@ -582,7 +591,9 @@ erts_sys_pre_init(void) #if !CHLDWTHR && !defined(ERTS_SMP) children_died = 0; #endif + #endif /* USE_THREADS */ + erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); { @@ -1003,25 +1014,6 @@ static void unblock_signals(void) } -/************************** Time stuff **************************/ -#ifdef HAVE_GETHRTIME -#ifdef GETHRTIME_WITH_CLOCK_GETTIME - -SysHrTime sys_gethrtime(void) -{ - struct timespec ts; - long long result; - if (clock_gettime(CLOCK_MONOTONIC,&ts) != 0) { - erl_exit(1,"Fatal, could not get clock_monotonic value!, " - "errno = %d\n", errno); - } - result = ((long long) ts.tv_sec) * 1000000000LL + - ((long long) ts.tv_nsec); - return (SysHrTime) result; -} -#endif -#endif - /************************** OS info *******************************/ /* Used by erlang:info/1. */ diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 2ffa649767..c30ef7cce2 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -85,7 +85,7 @@ static void set_current_fp_exception(unsigned long pc) void erts_fp_check_init_error(volatile unsigned long *fpexnp) { - char buf[64]; + char buf[128]; snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n", __builtin_return_address(0), (void*)*fpexnp); if (write(2, buf, strlen(buf)) <= 0) diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index fcce54a2c4..dc1822b21c 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -31,8 +31,21 @@ # undef _FILE_OFFSET_BITS #endif +#include <stdlib.h> #include "sys.h" #include "global.h" +#include "erl_os_monotonic_time_extender.h" + +#undef ERTS_HAVE_ERTS_OS_TIMES_IMPL__ +#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) \ + || defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) +# include <mach/clock.h> +# include <mach/mach.h> +# define ERTS_MACH_CLOCKS +#endif #ifdef NO_SYSCONF # define TICKS_PER_SEC() HZ @@ -53,9 +66,23 @@ /******************* Routines for time measurement *********************/ -int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */ -int erts_ticks_per_sec_wrap = 0; /* Will be SYS_CLK_TCK_WRAP */ -static int ticks_bsr = 0; /* Shift wrapped tick value this much to the right */ +#undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ +#undef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__ +#undef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__ + +#if defined(OS_MONOTONIC_TIME_USING_TIMES) + +static Uint32 +get_tick_count(void) +{ + struct tms unused; + return (Uint32) times(&unused); +} + +#define ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__ +#define ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__ + +#endif /* * init timers, chose a tick length, and return it. @@ -63,37 +90,824 @@ static int ticks_bsr = 0; /* Shift wrapped tick value this much to the right */ * does almost everything. Other platforms have to * emulate Unix in this sense. */ -int sys_init_time(void) + +ErtsSysTimeData__ erts_sys_time_data__ erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) + +#define ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ + +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(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 + +#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__ +struct sys_time_internal_state_read_mostly__ { +#if defined(OS_MONOTONIC_TIME_USING_TIMES) + ErtsOsMonotonicTimeExtendState os_mtime_xtnd; +#endif +}; +#endif + +#ifdef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ +struct sys_time_internal_state_write_freq__ { + erts_smp_mtx_t mtx; +#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) + ErtsMonotonicTime last_delivered; +#endif +}; +#endif + +#if defined(ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__) \ + || defined(ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__) +static struct { +#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__ + union { + struct sys_time_internal_state_read_only__ o; + char align__[(((sizeof(struct sys_time_internal_state_read_only__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } r; +#endif +#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__ + union { + struct sys_time_internal_state_read_mostly__ m; + char align__[(((sizeof(struct sys_time_internal_state_read_mostly__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } wr; +#endif +#ifdef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ + union { + struct sys_time_internal_state_write_freq__ f; + char align__[(((sizeof(struct sys_time_internal_state_write_freq__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } w; +#endif +} internal_state erts_align_attribute(ERTS_CACHE_LINE_SIZE); +#endif + +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) */ + +#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) + { + struct timespec ts; + if (clock_getres(MONOTONIC_CLOCK_ID, &ts) == 0) { + if (ts.tv_sec == 0 && ts.tv_nsec != 0) + init_resp->os_monotonic_time_info.resolution /= ts.tv_nsec; + else if (ts.tv_sec >= 1) + init_resp->os_monotonic_time_info.resolution = 1; + } + } +#elif defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(MONOTONIC_CLOCK_ID) + init_resp->os_monotonic_time_info.resolution + = mach_clock_getres(&internal_state.r.o.mach.clock.monotonic); +#endif + +#ifdef MONOTONIC_CLOCK_ID_STR + init_resp->os_monotonic_time_info.clock_id = MONOTONIC_CLOCK_ID_STR; +#else + init_resp->os_monotonic_time_info.clock_id = NULL; +#endif + + init_resp->os_monotonic_time_info.locked_use = 0; + +#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) + init_resp->os_monotonic_time_info.func = "clock_gettime"; +#elif defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) + init_resp->os_monotonic_time_info.func = "clock_get_time"; +#elif defined(OS_MONOTONIC_TIME_USING_GETHRTIME) + init_resp->os_monotonic_time_info.func = "gethrtime"; +#elif defined(OS_MONOTONIC_TIME_USING_TIMES) + init_resp->os_monotonic_time_info.func = "times"; +#else +# error Unknown erts_os_monotonic_time() implementation +#endif + + init_resp->have_os_monotonic_time = 1; + + os_version(&major, &minor, &build); + + vsn = ERTS_MK_VSN_INT(major, minor, build); + + +#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; +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + erts_sys_time_data__.r.o.os_times = + clock_gettime_times; +#endif + } + else { + /* + * Linux versions prior to 2.6.33 have a + * 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. + */ + 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_raw; +#endif + 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)) */ + { + char flavor[1024]; + + os_flavor(flavor, sizeof(flavor)); + + if (sys_strcmp(flavor, "sunos") == 0) { + /* + * Don't trust hrtime on multi processors + * on SunOS prior to SunOS 5.8 + */ + if (vsn < ERTS_MK_VSN_INT(5, 8, 0)) { +#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF) + if (sysconf(_SC_NPROCESSORS_CONF) > 1) +#endif + init_resp->have_os_monotonic_time = 0; + } + } + } +#endif /* !(defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)) */ + +#endif /* defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) */ + +#ifdef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT + init_resp->os_monotonic_time_unit = ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT; +#endif + init_resp->sys_clock_resolution = SYS_CLOCK_RESOLUTION; + /* - * This (erts_ticks_per_sec) is only for times() (CLK_TCK), - * the resolution is always one millisecond.. + * This (erts_sys_time_data__.r.o.ticks_per_sec) is only for + * times() (CLK_TCK), the resolution is always one millisecond.. */ - if ((erts_ticks_per_sec = TICKS_PER_SEC()) < 0) - erl_exit(1, "Can't get clock ticks/sec\n"); - if (erts_ticks_per_sec >= 1000) { - /* Workaround for beta linux kernels, need to be done in runtime - to make erlang run on both 2.4 and 2.5 kernels. In the future, - the kernel ticks might as - well be used as a high res timer instead, but that's for when the - majority uses kernels with HZ == 1024 */ - ticks_bsr = 3; - } else { - ticks_bsr = 0; + if ((erts_sys_time_data__.r.o.ticks_per_sec = TICKS_PER_SEC()) < 0) + erl_exit(ERTS_ABORT_EXIT, "Can't get clock ticks/sec\n"); + +#if defined(OS_MONOTONIC_TIME_USING_TIMES) +#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT +# error Time unit is supposed to be determined at runtime... +#endif + { + ErtsMonotonicTime resolution = erts_sys_time_data__.r.o.ticks_per_sec; + ErtsMonotonicTime time_unit = resolution; + int shift = 0; + + while (time_unit < 1000*1000) { + time_unit <<= 1; + shift++; + } + + init_resp->os_monotonic_time_info.resolution = resolution; + init_resp->os_monotonic_time_unit = time_unit; + init_resp->os_monotonic_time_info.extended = 1; + internal_state.r.o.times_shift = shift; + + erts_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd, + get_tick_count, + (1 << 29) / resolution); + } +#endif /* defined(OS_MONOTONIC_TIME_USING_TIMES) */ + +#ifdef WALL_CLOCK_ID_STR + init_resp->os_system_time_info.clock_id = WALL_CLOCK_ID_STR; +#else + init_resp->os_system_time_info.clock_id = NULL; +#endif + + init_resp->os_system_time_info.locked_use = 0; + init_resp->os_system_time_info.resolution = (Uint64) 1000*1000*1000; +#if defined(HAVE_CLOCK_GETRES) && defined(WALL_CLOCK_ID) + { + struct timespec ts; + if (clock_getres(WALL_CLOCK_ID, &ts) == 0) { + if (ts.tv_sec == 0 && ts.tv_nsec != 0) + init_resp->os_system_time_info.resolution /= ts.tv_nsec; + else if (ts.tv_sec >= 1) + init_resp->os_system_time_info.resolution = 1; + } + } +#elif defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(WALL_CLOCK_ID) + init_resp->os_system_time_info.resolution + = mach_clock_getres(&internal_state.r.o.mach.clock.wall); +#endif + +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + init_resp->os_system_time_info.func = "clock_gettime"; +#elif defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) + init_resp->os_system_time_info.func = "clock_get_time"; +#elif defined(OS_SYSTEM_TIME_GETTIMEOFDAY) + init_resp->os_system_time_info.func = "gettimeofday"; + init_resp->os_system_time_info.resolution = 1000*1000; + init_resp->os_system_time_info.clock_id = NULL; +#else +# error Missing erts_os_system_time() implementation +#endif + +} + +void +erts_late_sys_init_time(void) +{ +#if defined(OS_MONOTONIC_TIME_USING_TIMES) + erts_late_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd); +#endif +} + +static ERTS_INLINE ErtsSystemTime +adj_stime_time_unit(ErtsSystemTime stime, Uint32 res) +{ + if (res == ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT) + return stime; + if (res == (Uint32) 1000*1000*1000 + && ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000) + return stime/1000; + if (res == (Uint32) 1000*1000 + && ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000*1000) + return stime*1000; + return ((ErtsSystemTime) + erts_time_unit_conversion(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() * +\* */ + +#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \ + || defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + +static ERTS_INLINE Sint64 +posix_clock_gettime(clockid_t id, char *name) +{ + struct timespec ts; + + if (clock_gettime(id, &ts) != 0) { + int err = errno; + char *errstr = err ? strerror(err) : "unknown"; + erl_exit(ERTS_ABORT_EXIT, + "clock_gettime(%s, _) failed: %s (%d)\n", + name, errstr, err); + } + return ERTS_TimeSpec2Sint64(&ts); +} + +#endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \ + || defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ + +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + +ErtsSystemTime +erts_os_system_time(void) +{ + 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) */ + +#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) + +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + +#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__ + +static ERTS_INLINE void +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(mid, &mts); + merr = errno; + 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", + mname, errstr, merr); + } + if (sres != 0) { + char *errstr = serr ? strerror(serr) : "unknown"; + erl_exit(ERTS_ABORT_EXIT, + "clock_gettime(%s, _) failed: %s (%d)\n", + sname, errstr, serr); + } + + *mtimep = (ErtsMonotonicTime) ERTS_TimeSpec2Sint64(&mts); + *stimep = (ErtsSystemTime) ERTS_TimeSpec2Sint64(&sts); +} + +#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ + +#if defined(__linux__) + +static ErtsMonotonicTime clock_gettime_monotonic_verified(void) +{ + 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) + mtime = internal_state.w.f.last_delivered; + else + internal_state.w.f.last_delivered = mtime; + erts_smp_mtx_unlock(&internal_state.w.f.mtx); + + return mtime; +} + +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + +static void clock_gettime_times_verified(ErtsMonotonicTime *mtimep, + ErtsSystemTime *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) + *mtimep = internal_state.w.f.last_delivered; + else + internal_state.w.f.last_delivered = *mtimep; + erts_smp_mtx_unlock(&internal_state.w.f.mtx); +} + +#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 (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(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__) */ + +ErtsMonotonicTime erts_os_monotonic_time(void) +{ + return posix_clock_gettime(MONOTONIC_CLOCK_ID, + MONOTONIC_CLOCK_ID_STR); +} + +#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) + +void erts_os_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); +} + +#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */ + +#endif /* !defined(__linux__) */ + +#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(HRTIME_CLOCK_ID, + HRTIME_CLOCK_ID_STR); +} + +#endif /* defined(SYS_HRTIME_USING_CLOCK_GETTIME) */ + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * MACH clock_get_time() * +\* */ + +#if defined(ERTS_MACH_CLOCKS) + +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 void +mach_clocks_init(void) +{ + kern_return_t kret; + 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(); + +#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", + name); + } +#endif + +#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", + clk->name); + } + + return (Sint64) attr[0]; +} + +#endif /* ERTS_HAVE_MACH_CLOCK_GETRES */ + +static ERTS_INLINE Sint64 +mach_clock_get_time(ErtsMachClock *clk) +{ + kern_return_t kret; + mach_timespec_t time_spec; + + 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); + + return ERTS_TimeSpec2Sint64(&time_spec); +} + +#endif /* defined(ERTS_MACH_CLOCKS) */ + +#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) + +#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__ + +ErtsSystemTime +erts_os_system_time(void) +{ + 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) */ + +#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) + +ErtsMonotonicTime +erts_os_monotonic_time(void) +{ + return (ErtsMonotonicTime) + mach_clock_get_time(&internal_state.r.o.mach.clock.monotonic); +} + +#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) + +#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__ + +void +erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + kern_return_t mkret, skret; + mach_timespec_t mon_time_spec, sys_time_spec; + + 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", + internal_state.r.o.mach.clock.monotonic.name); + if (skret != KERN_SUCCESS) + erl_exit(ERTS_ABORT_EXIT, + "clock_get_time(%s, _) failed\n", + internal_state.r.o.mach.clock.wall.name); + + *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 * +\* */ + +#if defined(OS_MONOTONIC_TIME_USING_GETHRTIME) + +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 +erts_sys_hrtime(void) +{ + return (ErtsSysHrTime) gethrtime(); +} + +#endif /* defined(SYS_HRTIME_USING_GETHRTIME) */ + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * gettimeofday() - OS system time * +\* */ + +#if defined(OS_SYSTEM_TIME_GETTIMEOFDAY) + +ErtsSystemTime +erts_os_system_time(void) +{ + ErtsSystemTime stime; + struct timeval tv; + + if (gettimeofday(&tv, NULL) != 0) { + int err = errno; + char *errstr = err ? strerror(err) : "unknown"; + erl_exit(ERTS_ABORT_EXIT, + "gettimeofday(_, NULL) failed: %s (%d)\n", + errstr, err); } - erts_ticks_per_sec_wrap = (erts_ticks_per_sec >> ticks_bsr); - return SYS_CLOCK_RESOLUTION; + + stime = (ErtsSystemTime) tv.tv_sec; + stime *= (ErtsSystemTime) 1000*1000; + stime += (ErtsSystemTime) tv.tv_usec; + + return adj_stime_time_unit(stime, (Uint32) 1000*1000); } -clock_t sys_times_wrap(void) +#endif /* defined(OS_SYSTEM_TIME_GETTIMEOFDAY) */ + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * times() - OS monotonic time * +\* */ + +#if defined(OS_MONOTONIC_TIME_USING_TIMES) + +ErtsMonotonicTime +erts_os_monotonic_time(void) +{ + Uint32 ticks = get_tick_count(); + ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + return ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks) << internal_state.r.o.times_shift; +} + +#endif + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Fallbacks * +\* */ + +#ifndef ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__ + +ErtsSysHrTime +erts_sys_hrtime(void) { - SysTimes dummy; - clock_t result = (sys_times(&dummy) >> ticks_bsr); - return result; + return (ErtsSysHrTime) ERTS_MONOTONIC_TO_NSEC(erts_os_system_time()); } +#endif + +#if !defined(ERTS_HAVE_ERTS_OS_TIMES_IMPL__) \ + && defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) +void +erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + *mtimep = erts_os_monotonic_time(); + *stimep = erts_os_system_time(); +} + +#endif +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ #ifdef HAVE_GETHRVTIME_PROCFS_IOCTL diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 972170d465..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 @@ -285,7 +286,7 @@ struct ErtsPollSet_ { #ifdef ERTS_SMP erts_smp_mtx_t mtx; #endif - erts_smp_atomic32_t timeout; + erts_atomic64_t timeout_time; }; #ifdef ERTS_SMP @@ -363,6 +364,26 @@ do { \ wait_standby(PS); \ } while(0) +static ERTS_INLINE void +init_timeout_time(ErtsPollSet ps) +{ + erts_atomic64_init_nob(&ps->timeout_time, + (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX); +} + +static ERTS_INLINE void +set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time) +{ + erts_atomic64_set_relb(&ps->timeout_time, + (erts_aint64_t) time); +} + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_time(ErtsPollSet ps) +{ + return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time); +} + #define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) 0) #define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) 1) #define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) 2) @@ -422,15 +443,29 @@ wakeup_cause(ErtsPollSet ps) } static ERTS_INLINE DWORD -poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp) +poll_wait_timeout(ErtsPollSet ps, ErtsMonotonicTime timeout_time) { - time_t timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; + ErtsMonotonicTime current_time, diff_time, timeout; - if (timeout <= 0) { + if (timeout_time == ERTS_POLL_NO_TIMEOUT) { + no_timeout: + set_timeout_time(ps, ERTS_MONOTONIC_TIME_MIN); woke_up(ps); return (DWORD) 0; } + current_time = erts_get_monotonic_time(NULL); + diff_time = timeout_time - current_time; + if (diff_time <= 0) + goto no_timeout; + + /* Round up to nearest milli second */ + timeout = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1); + if (timeout > INT_MAX) + timeout = INT_MAX; /* Also prevents DWORD overflow */ + + set_timeout_time(ps, current_time + ERTS_MSEC_TO_MONOTONIC(timeout)); + ResetEvent(ps->event_io_ready); /* * Since we don't know the internals of ResetEvent() we issue @@ -442,10 +477,6 @@ poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp) if (erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN) return (DWORD) 0; - if (timeout > ((time_t) ERTS_AINT32_T_MAX)) - timeout = ERTS_AINT32_T_MAX; /* Also prevents DWORD overflow */ - - erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); return (DWORD) timeout; } @@ -1012,12 +1043,12 @@ void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */) void erts_poll_interrupt_timed(ErtsPollSet ps, int set /* bool */, - erts_short_time_t msec) + ErtsMonotonicTime timeout_time) { - HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec)); + HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,timeout_time)); if (!set) reset_interrupt(ps); - else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + else if (get_timeout_time(ps) > timeout_time) set_interrupt(ps); HARDTRACEF(("Out erts_poll_interrupt_timed")); } @@ -1092,7 +1123,7 @@ void erts_poll_controlv(ErtsPollSet ps, int erts_poll_wait(ErtsPollSet ps, ErtsPollResFd pr[], int *len, - SysTimeval *tvp) + ErtsMonotonicTime timeout_time) { int no_fds; DWORD timeout; @@ -1149,7 +1180,7 @@ int erts_poll_wait(ErtsPollSet ps, no_fds = ERTS_POLL_MAX_RES; #endif - timeout = poll_wait_timeout(ps, tvp); + timeout = poll_wait_timeout(ps, timeout_time); /*HARDDEBUGF(("timeout = %ld",(long) timeout));*/ @@ -1242,7 +1273,7 @@ int erts_poll_wait(ErtsPollSet ps, erts_mtx_unlock(&w->mtx); } done: - erts_smp_atomic32_set_nob(&ps->timeout, ERTS_AINT32_T_MAX); + set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX); *len = num; ERTS_POLLSET_UNLOCK(ps); HARDTRACEF(("Out erts_poll_wait")); @@ -1326,7 +1357,7 @@ ErtsPollSet erts_poll_create_pollset(void) #ifdef ERTS_SMP erts_smp_mtx_init(&ps->mtx, "pollset"); #endif - erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX); + init_timeout_time(ps); HARDTRACEF(("Out erts_poll_create_pollset")); return ps; diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index fde32c8684..a9e37e47a7 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -120,9 +120,6 @@ /* * For erl_time_sup */ -#define HAVE_GETHRTIME - -#define sys_init_hrtime() /* Nothing */ #define SYS_CLK_TCK 1000 #define SYS_CLOCK_RESOLUTION 1 @@ -164,18 +161,81 @@ typedef struct { #if defined (__GNUC__) typedef unsigned long long Uint64; typedef long long Sint64; - -typedef long long SysHrTime; +# ifdef ULLONG_MAX +# define ERTS_UINT64_MAX ULLONG_MAX +# endif +# ifdef LLONG_MAX +# define ERTS_SINT64_MAX LLONG_MAX +# endif +# ifdef LLONG_MIN +# define ERTS_SINT64_MIN LLONG_MIN +# endif + +typedef long long ErtsMonotonicTime; +typedef long long ErtsSysHrTime; #else typedef ULONGLONG Uint64; typedef LONGLONG Sint64; -typedef LONGLONG SysHrTime; +typedef LONGLONG ErtsMonotonicTime; +typedef LONGLONG ErtsSysHrTime; #endif -extern int sys_init_time(void); +typedef ErtsMonotonicTime ErtsSystemTime; + +ErtsSystemTime erts_os_system_time(void); + +#define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63) +#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN) + +#define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1 +#define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT 0 + +struct erts_sys_time_read_only_data__ { + ErtsMonotonicTime (*os_monotonic_time)(void); + void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime*); + ErtsSysHrTime (*sys_hrtime)(void); +}; + +typedef struct { + union { + struct erts_sys_time_read_only_data__ o; + char align__[(((sizeof(struct erts_sys_time_read_only_data__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } r; +} ErtsSysTimeData__; + +extern ErtsSysTimeData__ erts_sys_time_data__; + +ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void); +ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *, + ErtsSystemTime *); +ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsMonotonicTime +erts_os_monotonic_time(void) +{ + return (*erts_sys_time_data__.r.o.os_monotonic_time)(); +} + +ERTS_GLB_INLINE void +erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); +} + +ERTS_GLB_INLINE ErtsSysHrTime +erts_sys_hrtime(void) +{ + return (*erts_sys_time_data__.r.o.sys_hrtime)(); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + extern void sys_gettimeofday(SysTimeval *tv); -extern SysHrTime sys_gethrtime(void); extern clock_t sys_times(SysTimes *buffer); extern char *win_build_environment(char *); @@ -207,6 +267,8 @@ extern volatile int erl_fp_exception; int _finite(double x); #endif +#define erts_isfinite _finite + /*#define NO_FPE_SIGNALS*/ #define erts_get_current_fp_exception() NULL #define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 5d51659b4e..cf587af4ac 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3172,25 +3172,31 @@ thr_create_prepare_child(void *vtcdp) void erts_sys_pre_init(void) { +#ifdef USE_THREADS + erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; +#endif int_os_version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); GetVersionEx(&int_os_version); check_supported_os_version(); + #ifdef USE_THREADS - { - erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; + eid.thread_create_child_func = thr_create_prepare_child; + /* Before creation in parent */ + eid.thread_create_prepare_func = thr_create_prepare; + /* After creation in parent */ + eid.thread_create_parent_func = thr_create_cleanup; - eid.thread_create_child_func = thr_create_prepare_child; - /* Before creation in parent */ - eid.thread_create_prepare_func = thr_create_prepare; - /* After creation in parent */ - eid.thread_create_parent_func = thr_create_cleanup, + erts_thr_init(&eid); +#endif - erts_thr_init(&eid); + erts_init_sys_time_sup(); + +#ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init(); + erts_lcnt_init(); #endif - } #endif + erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); } @@ -3273,9 +3279,9 @@ erts_sys_schedule_interrupt(int set) #ifdef ERTS_SMP void -erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) +erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time) { - erts_check_io_interrupt_timed(set, msec); + erts_check_io_interrupt_timed(set, timeout_time); } #endif diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index b84c8f85ce..7da060a7a7 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -25,6 +25,11 @@ #endif #include "sys.h" #include "assert.h" +#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) @@ -61,11 +66,6 @@ (epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_JULIAN_DIFF); \ } while(0) -static SysHrTime wrap = 0; -static DWORD last_tick_count = 0; -static erts_smp_mtx_t wrap_lock; -static ULONGLONG (WINAPI *pGetTickCount64)(void) = NULL; - /* Getting timezone information is a heavy operation, so we want to do this only once */ @@ -76,27 +76,348 @@ static int days_in_month[2][13] = { {0,31,28,31,30,31,30,31,31,30,31,30,31}, {0,31,29,31,30,31,30,31,31,30,31,30,31}}; -int -sys_init_time(void) +#define ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT 10 + +/* + * erts_os_monotonic_time() + */ + +struct sys_time_internal_state_read_only__ { + ULONGLONG (WINAPI *pGetTickCount64)(void); + BOOL (WINAPI *pQueryPerformanceCounter)(LARGE_INTEGER *); + Sint32 pcf; + int using_get_tick_count_time_unit; +}; + +struct sys_time_internal_state_read_mostly__ { + ErtsOsMonotonicTimeExtendState os_mtime_xtnd; +}; + +struct sys_time_internal_state_write_freq__ { + erts_smp_mtx_t mtime_mtx; + ULONGLONG wrap; + ULONGLONG last_tick_count; +}; + +__declspec(align(ASSUMED_CACHE_LINE_SIZE)) struct { + union { + struct sys_time_internal_state_read_only__ o; + char align__[(((sizeof(struct sys_time_internal_state_read_only__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } r; + union { + struct sys_time_internal_state_read_mostly__ m; + char align__[(((sizeof(struct sys_time_internal_state_read_mostly__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } wr; + union { + struct sys_time_internal_state_write_freq__ f; + char align__[(((sizeof(struct sys_time_internal_state_write_freq__) - 1) + / ASSUMED_CACHE_LINE_SIZE) + 1) + * ASSUMED_CACHE_LINE_SIZE]; + } w; +} internal_state; + +__declspec(align(ASSUMED_CACHE_LINE_SIZE)) ErtsSysTimeData__ erts_sys_time_data__; + + +static ERTS_INLINE ErtsSystemTime +SystemTime2MilliSec(SYSTEMTIME *stp) +{ + ErtsSystemTime stime; + FILETIME ft; + ULARGE_INTEGER ull; + + SystemTimeToFileTime(stp, &ft); + FILETIME_TO_ULI(ull,ft); + /* now in 100 ns units */ + stime = (ErtsSystemTime) ull.QuadPart; + stime -= (((ErtsSystemTime) EPOCH_JULIAN_DIFF) + * ((ErtsSystemTime) (10*1000*1000))); + stime /= (ErtsSystemTime) (10*1000); /* ms */ + return stime; +} + +static ErtsMonotonicTime +os_monotonic_time_qpc(void) +{ + LARGE_INTEGER pc; + + if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc)) + erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n"); + + return (ErtsMonotonicTime) pc.QuadPart; +} + +static void +os_times_qpc(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + LARGE_INTEGER pc; + SYSTEMTIME st; + ErtsSystemTime stime; + BOOL qpcr; + + qpcr = (*internal_state.r.o.pQueryPerformanceCounter)(&pc); + GetSystemTime(&st); + + if (!qpcr) + erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n"); + + *mtimep = (ErtsMonotonicTime) pc.QuadPart; + + stime = SystemTime2MilliSec(&st); + + *stimep = ((ErtsSystemTime) + erts_time_unit_conversion((Uint64) stime, + (Uint32) 1000, + internal_state.r.o.pcf)); +} + +static Uint32 +get_tick_count(void) +{ + return (Uint32) GetTickCount(); +} + +static ErtsMonotonicTime +os_monotonic_time_gtc32(void) +{ + ErtsMonotonicTime mtime; + Uint32 ticks = (Uint32) GetTickCount(); + ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + return mtime; +} + +static void +os_times_gtc32(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + SYSTEMTIME st; + ErtsSystemTime stime, mtime; + Uint32 ticks; + + ticks = (Uint32) GetTickCount(); + GetSystemTime(&st); + + ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + *mtimep = mtime; + + stime = SystemTime2MilliSec(&st); + stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + *stimep = stime; + +} + +static ErtsMonotonicTime +os_monotonic_time_gtc64(void) +{ + ULONGLONG ticks = (*internal_state.r.o.pGetTickCount64)(); + ErtsMonotonicTime mtime = (ErtsMonotonicTime) ticks; + return mtime << ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; +} + +static void +os_times_gtc64(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) +{ + SYSTEMTIME st; + ErtsSystemTime stime, mtime; + ULONGLONG ticks; + + ticks = (*internal_state.r.o.pGetTickCount64)(); + GetSystemTime(&st); + + mtime = (ErtsMonotonicTime) ticks; + mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + *mtimep = mtime; + + stime = SystemTime2MilliSec(&st); + stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + *stimep = stime; +} + +static ErtsSysHrTime +sys_hrtime_qpc(void) +{ + LARGE_INTEGER pc; + + if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc)) + erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n"); + + ASSERT(pc.QuadPart > 0); + + return (ErtsSysHrTime) erts_time_unit_conversion((Uint64) pc.QuadPart, + internal_state.r.o.pcf, + (Uint32) 1000*1000*1000); +} + +static ErtsSysHrTime +sys_hrtime_gtc32(void) +{ + ErtsSysHrTime time; + Uint32 ticks = (Uint32) GetTickCount(); + ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + tick_count); + time = (ErtsSysHrTime) ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd, + ticks); + time *= (ErtsSysHrTime) (1000 * 1000); + return time; +} + +static ErtsSysHrTime +sys_hrtime_gtc64(void) +{ + ErtsSysHrTime time = (*internal_state.r.o.pGetTickCount64)(); + time *= (ErtsSysHrTime) (1000*1000); + return time; +} + +/* + * Init + */ + +void +sys_init_time(ErtsSysInitTimeResult *init_resp) { + ErtsMonotonicTime (*os_mtime_func)(void); + void (*os_times_func)(ErtsMonotonicTime *, ErtsSystemTime *); + ErtsSysHrTime (*sys_hrtime_func)(void) = NULL; + ErtsMonotonicTime time_unit; char kernel_dll_name[] = "kernel32"; HMODULE module; + init_resp->os_monotonic_time_info.clock_id = NULL; + module = GetModuleHandle(kernel_dll_name); - pGetTickCount64 = (module != NULL) ? - (ULONGLONG (WINAPI *)(void)) - GetProcAddress(module,"GetTickCount64") : - NULL; + if (!module) { + get_tick_count: + erts_smp_mtx_init(&internal_state.w.f.mtime_mtx, + "os_monotonic_time"); + internal_state.w.f.wrap = 0; + internal_state.w.f.last_tick_count = 0; + + init_resp->os_monotonic_time_info.func = "GetTickCount"; + init_resp->os_monotonic_time_info.locked_use = 0; + /* 10-16 ms resolution according to MicroSoft documentation */ + init_resp->os_monotonic_time_info.resolution = 100; /* 10 ms */ + time_unit = (ErtsMonotonicTime) 1000; + time_unit <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + internal_state.r.o.using_get_tick_count_time_unit = 1; + os_mtime_func = os_monotonic_time_gtc32; + os_times_func = os_times_gtc32; + init_resp->os_monotonic_time_info.extended = 1; + erts_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd, + get_tick_count, + 60*60*24*7); /* Check once a week */ + if (!sys_hrtime_func) + sys_hrtime_func = sys_hrtime_gtc32; + } + else { + int major, minor, build; + + os_version(&major, &minor, &build); + + if (major < 6) { + + get_tick_count64: + + internal_state.r.o.pGetTickCount64 + = ((ULONGLONG (WINAPI *)(void)) + GetProcAddress(module, "GetTickCount64")); + if (!internal_state.r.o.pGetTickCount64) + goto get_tick_count; + + init_resp->os_monotonic_time_info.func = "GetTickCount64"; + init_resp->os_monotonic_time_info.locked_use = 0; + /* 10-16 ms resolution according to MicroSoft documentation */ + init_resp->os_monotonic_time_info.resolution = 100; /* 10 ms */ + time_unit = (ErtsMonotonicTime) 1000; + time_unit <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + internal_state.r.o.using_get_tick_count_time_unit = 1; + os_mtime_func = os_monotonic_time_gtc64; + os_times_func = os_times_gtc64; + if (!sys_hrtime_func) + sys_hrtime_func = sys_hrtime_gtc64; + } + else { /* Vista or newer... */ + + LARGE_INTEGER pf; + BOOL (WINAPI *QPF)(LARGE_INTEGER *); + + QPF = ((BOOL (WINAPI *)(LARGE_INTEGER *)) + GetProcAddress(module, "QueryPerformanceFrequency")); + if (!QPF) + goto get_tick_count64; + if (!(*QPF)(&pf)) + goto get_tick_count64; + + internal_state.r.o.pQueryPerformanceCounter + = ((BOOL (WINAPI *)(LARGE_INTEGER *)) + GetProcAddress(module, "QueryPerformanceCounter")); + if (!internal_state.r.o.pQueryPerformanceCounter) + goto get_tick_count64; + + 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 + * os-monotonic-time if its frequency is equal + * to, or larger than GHz in order to ensure + * that the user wont be able to observe faulty + * order between values retrieved on different threads. + */ + 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; + internal_state.r.o.using_get_tick_count_time_unit = 0; + init_resp->os_monotonic_time_info.resolution = time_unit; + os_mtime_func = os_monotonic_time_qpc; + os_times_func = os_times_qpc; + } + } + + erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func; + 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"; + init_resp->os_system_time_info.clock_id = NULL; + init_resp->os_system_time_info.resolution = 100; + init_resp->os_system_time_info.locked_use = 0; if(GetTimeZoneInformation(&static_tzi) && static_tzi.StandardDate.wMonth != 0 && static_tzi.DaylightDate.wMonth != 0) { have_static_tzi = 1; } +} - erts_smp_mtx_init(&wrap_lock, "sys_gethrtime"); - - return 1; +void +erts_late_sys_init_time(void) +{ + if (erts_sys_time_data__.r.o.os_monotonic_time == os_monotonic_time_gtc32) + erts_late_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd); } /* Returns a switchtimes for DST as UTC filetimes given data from a @@ -377,41 +698,27 @@ sys_gettimeofday(SysTimeval *tv) EPOCH_JULIAN_DIFF); } -extern int erts_initialized; -SysHrTime -sys_gethrtime(void) +ErtsSystemTime +erts_os_system_time(void) { - if (pGetTickCount64 != NULL) { - return ((SysHrTime) pGetTickCount64()) * LL_LITERAL(1000000); - } else { - DWORD ticks; - SysHrTime res; - erts_smp_mtx_lock(&wrap_lock); - ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF); - if (ticks < (SysHrTime) last_tick_count) { - /* Detect a race that should no longer be here... */ - if ((((SysHrTime) last_tick_count) - ((SysHrTime) ticks)) > 1000) { - wrap += LL_LITERAL(1) << 31; - } else { - /* - * XXX Debug: Violates locking order, remove all this, - * after testing! - */ - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Did not wrap when last_tick %d " - "and tick %d", - last_tick_count, ticks); - erts_send_error_to_logger_nogl(dsbufp); - ticks = last_tick_count; - } - } - last_tick_count = ticks; - res = ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000)); - erts_smp_mtx_unlock(&wrap_lock); - return res; + SYSTEMTIME st; + ErtsSystemTime stime; + + GetSystemTime(&st); + stime = SystemTime2MilliSec(&st); + + if (internal_state.r.o.using_get_tick_count_time_unit) { + stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT; + return stime; } + + return ((ErtsSystemTime) + erts_time_unit_conversion((Uint64) stime, + (Uint32) 1000, + internal_state.r.o.pcf)); } + clock_t sys_times(SysTimes *buffer) { clock_t kernel_ticks = (GetTickCount() / diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index dfbe47786a..4dc4b5027d 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -108,6 +108,7 @@ MODULES= \ trace_call_time_SUITE \ scheduler_SUITE \ old_scheduler_SUITE \ + unique_SUITE \ z_SUITE \ old_mod \ long_timers_test \ @@ -124,7 +125,8 @@ NO_OPT= bs_bincomp \ bs_match_tail \ bs_match_misc \ bs_utf \ - guard + guard \ + map NATIVE= hibernate 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/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 413bd3bcae..3193d56e2a 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2]). -export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1, borders/1, negative/1, big_float_1/1, big_float_2/1, - shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]). + shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]). %% Internal exports. -export([eval/1]). @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders, negative, {group, big_float}, shift_limit_1, - powmod, system_limit, otp_6692]. + powmod, system_limit, toobig, otp_6692]. groups() -> [{big_float, [], [big_float_1, big_float_2]}]. @@ -370,6 +370,16 @@ maxbig() -> id(I) -> I. +toobig(Config) when is_list(Config) -> + ?line {'EXIT',{{badmatch,_},_}} = (catch toobig()), + ok. + +toobig() -> + A = erlang:term_to_binary(lists:seq(1000000, 2200000)), + ASize = erlang:bit_size(A), + <<ANr:ASize>> = A, % should fail + ANr band ANr. + otp_6692(suite) -> []; otp_6692(doc) -> 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/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index e5c904cfb9..bc5928436f 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -71,6 +71,11 @@ test_size(Config) when is_list(Config) -> 4 = do_test_size(#{}), 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,256)])) >= map_size_lower_bound(256), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,4096)])) >= map_size_lower_bound(4096), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,254)])) >= map_size_lower_bound(254), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,239)])) >= map_size_lower_bound(239), + %% Test internal consistency of sizes, but without testing %% exact sizes. Const = id(42), @@ -92,14 +97,14 @@ test_size(Config) when is_list(Config) -> %% Test shared data structures. do_test_size([ConsCell1|ConsCell1], - 3*ConsCellSz, - 2*ConsCellSz), + 3*ConsCellSz, + 2*ConsCellSz), do_test_size(fun() -> {ConsCell1,ConsCell2} end, - FunSz2 + 2*ConsCellSz, - FunSz2 + ConsCellSz), + FunSz2 + 2*ConsCellSz, + FunSz2 + ConsCellSz), do_test_size({SimplestFun,SimplestFun}, - 2*FunSz0+do_test_size({a,b}), - FunSz0+do_test_size({a,b})), + 2*FunSz0+do_test_size({a,b}), + FunSz0+do_test_size({a,b})), M = id(#{ "atom" => first, i => 0}), do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32), @@ -113,6 +118,13 @@ do_test_size(Term, FlatSz, Sz) -> FlatSz = erts_debug:flat_size(Term), Sz = erts_debug:size(Term). +map_size_lower_bound(N) -> + %% this est. is a bit lower that actual lower bound + %% number of internal nodes + T = (N - 1) div 15, + %% total words + 2 + 17 * T + 2 * N. + flat_size_big(Config) when is_list(Config) -> %% Build a term whose external size only fits in a big num (on 32-bit CPU). flat_size_big_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF). diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 1de6d6fb56..67a53d94b1 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -339,7 +339,6 @@ micros() -> ]. macro(Ms,DataDir) -> - erlang:now(), %% compensate for old 4.3 firsttime clock bug :-( statistics(reductions), statistics(runtime), lists(500), %% fixup cache on first round @@ -369,10 +368,9 @@ run_micro(Top, M, DataDir) -> apply_micro(M) -> {GC0, Words0, _} = statistics(garbage_collection), statistics(reductions), - Before = erlang:now(), - + Before = monotonic_time(), Compensate = apply_micro(M#micro.function, M#micro.loops), - After = erlang:now(), + After = monotonic_time(), {GC1, Words1, _} = statistics(garbage_collection), {_, Reds} = statistics(reductions), Elapsed = subtr(Before, After), @@ -389,12 +387,13 @@ apply_micro(M) -> {kilo_reductions, Reds div 1000}, {gc_intensity, gci(Elapsed, GC1 - GC0, Words1 - Words0)}]. +monotonic_time() -> + try erlang:monotonic_time() catch error:undef -> erlang:now() end. -subtr(Before, After) -> - (element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)). +subtr(Before, After) when is_integer(Before), is_integer(After) -> + erlang:convert_time_unit(After-Before, native, micro_seconds); +subtr({_,_,_}=Before, {_,_,_}=After) -> + timer:now_diff(After, Before). gci(Micros, Words, Gcs) -> ((256 * Gcs) / Micros) + (Words / Micros). @@ -633,10 +632,10 @@ tup_trav(T, P, End) -> %% Port I/O port_io(I) -> EstoneCat = get(estone_cat), - Before = erlang:now(), + Before = monotonic_time(), Pps = make_port_pids(5, I, EstoneCat), %% 5 ports send_procs(Pps, go), - After = erlang:now(), + After = monotonic_time(), wait_for_pids(Pps), subtr(Before, After). @@ -854,10 +853,10 @@ handle_call(_From, State, [abc]) -> %% Binary handling, creating, manipulating and sending binaries binary_h(I) -> - Before = erlang:now(), + Before = monotonic_time(), P = spawn(?MODULE, echo, [self()]), B = list_to_binary(lists:duplicate(2000, 5)), - After = erlang:now(), + After = monotonic_time(), Compensate = subtr(Before, After), binary_h_2(I, P, B), Compensate. diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 4a45afa9e9..a07516b5a9 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -294,16 +294,13 @@ id(I) -> I. start_node(Config) when is_list(Config) -> ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), ?line Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 36889b6c36..1b92e3198e 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -77,7 +77,7 @@ grow_heap1(List, MaxLen, CurLen, up) -> grow_heap1([], _MaxLen, _, down) -> ok; grow_heap1([_|List], MaxLen, CurLen, down) -> - {_,_,C} = erlang:now(), + C=erlang:unique_integer([positive]), Num = C rem (length(List))+1, Elem = lists:nth(Num, List), NewList = lists:delete(Elem, List), @@ -136,7 +136,7 @@ grow_stack_heap1(List, MaxLen, CurLen, up) -> grow_stack_heap1([], _MaxLen, _, down) -> ok; grow_stack_heap1([_|List], MaxLen, CurLen, down) -> grow_stack1(CurLen*2,0), - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Num=C rem (length(List))+1, Elem=lists:nth(Num, List), NewList=lists:delete(Elem, List), @@ -146,8 +146,8 @@ grow_stack_heap1([_|List], MaxLen, CurLen, down) -> %% Create an arbitrary element/term. make_arbit() -> - {AA,BB,CC}=erlang:now(), - A=AA+1, B=BB+1, C=CC+1, + {AA,BB,CC}=erlang:timestamp(), + A=AA+1, B=BB+1, C=(CC+erlang:unique_integer([positive])) rem 1000000 + 1, New = case C rem 9 of 0 -> make_string((B div C) +5); @@ -171,7 +171,7 @@ make_string(Length) -> make_string(_, 0, Acc) -> Acc; make_string(Alph, Length, Acc) -> - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Pos=1+(Length*C rem length(Alph)), make_string(Alph, Length-1, [lists:nth(Pos,Alph)|Acc]). diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 647bb45049..5fa45f772d 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -73,6 +73,7 @@ config(priv_dir,_) -> init_per_group/2,end_per_group/2, test_basic/1,test_cmp/1,test_range/1,test_spread/1, test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, + test_hash_zero/1, end_per_testcase/2,init_per_testcase/2]). init_per_testcase(_Case, Config) -> Dog=test_server:timetrap(test_server:minutes(10)), @@ -86,7 +87,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [test_basic, test_cmp, test_range, test_spread, - test_phash2, otp_5292, bit_level_binaries, otp_7127]. + test_phash2, otp_5292, bit_level_binaries, otp_7127, + test_hash_zero + ]. groups() -> []. @@ -160,6 +163,8 @@ otp_7127(doc) -> otp_7127(Config) when is_list(Config) -> otp_7127_test(). +test_hash_zero(Config) when is_list(Config) -> + hash_zero_test(). -endif. @@ -591,6 +596,26 @@ otp_7127_test() -> 38990304 = erlang:phash2(<<"Scott9">>), ok. +hash_zero_test() -> + Zs = [0.0, -0.0, 0/-1, 0.0/-1, 0/-(1 bsl 65), + binary_to_term(<<131,70,0,0,0,0,0,0,0,0>>), %% +0.0 + binary_to_term(<<131,70,128,0,0,0,0,0,0,0>>)], %% -0.0 + ok = hash_zero_test(Zs,fun(T) -> erlang:phash2(T, 1 bsl 32) end), + ok = hash_zero_test(Zs,fun(T) -> erlang:phash(T, 1 bsl 32) end), + ok = hash_zero_test(Zs,fun(T) -> erlang:hash(T, (1 bsl 27) - 1) end), + ok. + +hash_zero_test([Z|Zs],F) -> + hash_zero_test(Zs,Z,F(Z),F). +hash_zero_test([Z|Zs],Z0,V,F) -> + true = Z0 =:= Z, %% assert exact equal + Z0 = Z, %% assert matching + V = F(Z), %% assert hash + hash_zero_test(Zs,Z0,V,F); +hash_zero_test([],_,_,_) -> + ok. + + %% %% Reference implementation of integer hashing %% diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index 28a4fba9f6..f381332b51 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -28,7 +28,7 @@ -define(MAX_TIMEOUT, 60). % Minutes --define(MAX_LATE, 10*1000). % Milliseconds +-define(MAX_LATE_MS, 10*1000). % Milliseconds -define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___'). -define(DRV_NAME, timer_driver). @@ -75,7 +75,7 @@ check_result() -> erlang:demonitor(Mon), receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end, stop_node(Node), - check(TORs, (timer:now_diff(End, Start) div 1000) - ?MAX_LATE, ok) + check(TORs, ms((End - Start) - max_late()), ok) end. check([#timeout_rec{timeout = Timeout, @@ -83,7 +83,7 @@ check([#timeout_rec{timeout = Timeout, timeout_diff = undefined} | TORs], NeedRes, _Ok) when Timeout < NeedRes -> - io:format("~p timeout = ~p failed! No timeout.~n", + io:format("~p timeout = ~p ms failed! No timeout.~n", [Type, Timeout]), check(TORs, NeedRes, failed); check([#timeout_rec{timeout_diff = undefined} | TORs], @@ -95,7 +95,7 @@ check([#timeout_rec{timeout = Timeout, timeout_diff = {error, Reason}} | TORs], NeedRes, _Ok) -> - io:format("~p timeout = ~p failed! exit reason ~p~n", + io:format("~p timeout = ~p ms failed! exit reason ~p~n", [Type, Timeout, Reason]), check(TORs, NeedRes, failed); check([#timeout_rec{timeout = Timeout, @@ -103,43 +103,77 @@ check([#timeout_rec{timeout = Timeout, timeout_diff = TimeoutDiff} | TORs], NeedRes, Ok) -> - case (0 =< TimeoutDiff) and (TimeoutDiff =< ?MAX_LATE) of - true -> - io:format("~p timeout = ~p succeded! timeout diff = ~p.~n", - [Type, Timeout, TimeoutDiff]), - check(TORs, NeedRes, Ok); - false -> - io:format("~p timeout = ~p failed! timeout diff = ~p.~n", - [Type, Timeout, TimeoutDiff]), - check(TORs, NeedRes, failed) - end; + {NewOk, SuccessStr} = case ((0 =< TimeoutDiff) + andalso (TimeoutDiff =< max_late())) of + true -> {Ok, "succeeded"}; + false -> {failed, "FAILED"} + end, + io:format("~s timeout = ~s ms ~s! timeout diff = ~s.~n", + [type_str(Type), + time_str(Timeout), + SuccessStr, + time_str(TimeoutDiff, erlang:convert_time_unit(1, seconds, native))]), + check(TORs, NeedRes, NewOk); check([], _NeedRes, Ok) -> Ok. +type_str(receive_after) -> "receive ... after"; +type_str(bif_timer) -> "BIF timer"; +type_str(driver) -> "driver". + +time_str(Time, Unit) -> + lists:flatten([time_str(Time), " ", unit_str(Unit)]). + +time_str(Time) -> + lists:reverse(conv_time_str(lists:reverse(integer_to_list(Time)))). + +conv_time_str([X,Y,Z,C|Cs]) when C /= $- -> + [X,Y,Z,$`|conv_time_str([C|Cs])]; +conv_time_str(Cs) -> + Cs. + +unit_str(1) -> "s"; +unit_str(1000) -> "ms"; +unit_str(1000000) -> "us"; +unit_str(1000000000) -> "ns"; +unit_str(Res) when is_integer(Res) -> ["/ ", integer_to_list(Res), " s"]; +unit_str(Res) -> Res. + +to_diff(Timeout, Start, Stop) -> + %% 'Timeout' in milli seconds + %% 'Start', 'Stop', and result in native unit + (Stop - Start) - erlang:convert_time_unit(Timeout, milli_seconds, native). + +ms(Time) -> + erlang:convert_time_unit(Time, native, milli_seconds). + +max_late() -> + erlang:convert_time_unit(?MAX_LATE_MS, milli_seconds, native). + receive_after(Timeout) -> - Start = now(), + Start = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout} after Timeout -> - Stop = now(), + Stop = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. driver(Timeout) -> Port = open_port({spawn, ?DRV_NAME},[]), link(Port), - Start = now(), + Start = erlang:monotonic_time(), erlang:port_command(Port, <<?START_TIMER, Timeout:32>>), receive {get_result, ?REG_NAME} -> @@ -147,38 +181,38 @@ driver(Timeout) -> type = driver, timeout = Timeout}; {Port,{data,[?TIMER]}} -> - Stop = now(), + Stop = erlang:monotonic_time(), unlink(Port), true = erlang:port_close(Port), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = driver, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. bif_timer(Timeout) -> Tmr = erlang:start_timer(Timeout, self(), ok), - Start = now(), + Start = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout}; {timeout, Tmr, ok} -> - Stop = now(), + Stop = erlang:monotonic_time(), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. @@ -189,7 +223,7 @@ test(Starter, DrvDir, StartDone) -> register(?REG_NAME, self()), {group_leader, GL} = process_info(whereis(net_kernel),group_leader), group_leader(GL, self()), - Start = now(), + Start = erlang:monotonic_time(), TORs = lists:map(fun (Min) -> TO = Min*60*1000, [#timeout_rec{pid = spawn_opt( @@ -222,7 +256,7 @@ test(Starter, DrvDir, StartDone) -> test_loop(TORs, Start) -> receive {get_result, ?REG_NAME, Pid} -> - End = now(), + End = erlang:monotonic_time(), Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End}, erl_ddll:unload_driver(?DRV_NAME), erl_ddll:stop(), diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 888ed8e272..527b6987fa 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -21,17 +21,24 @@ ]). -export([ - t_build_and_match_literals/1, - t_update_literals/1,t_match_and_update_literals/1, + t_build_and_match_literals/1, t_build_and_match_literals_large/1, + t_update_literals/1, t_update_literals_large/1, + t_match_and_update_literals/1, t_match_and_update_literals_large/1, t_update_map_expressions/1, - t_update_assoc/1,t_update_exact/1, - t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, - t_guard_receive/1, t_guard_fun/1, + t_update_assoc/1, t_update_assoc_large/1, + t_update_exact/1, t_update_exact_large/1, + t_guard_bifs/1, + t_guard_sequence/1, t_guard_sequence_large/1, + t_guard_update/1, t_guard_update_large/1, + t_guard_receive/1, t_guard_receive_large/1, + t_guard_fun/1, + t_update_deep/1, t_list_comprehension/1, t_map_sort_literals/1, t_map_equal/1, - %t_size/1, + t_map_compare/1, t_map_size/1, + t_is_map/1, %% Specific Map BIFs t_bif_map_get/1, @@ -51,6 +58,10 @@ t_erlang_hash/1, t_map_encode_decode/1, + %% non specific BIF related + t_bif_build_and_check/1, + t_bif_merge_and_check/1, + %% maps module not bifs t_maps_fold/1, t_maps_map/1, @@ -58,24 +69,45 @@ t_maps_without/1, %% misc + t_hashmap_balance/1, + t_erts_internal_order/1, + t_erts_internal_hash/1, t_pdict/1, t_ets/1, t_dets/1, - t_tracing/1 + t_tracing/1, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1, + badmap_17/1 ]). -include_lib("stdlib/include/ms_transform.hrl"). +-define(CHECK(Cond,Term), + case (catch (Cond)) of + true -> true; + _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]), + exit(Term) + end). + suite() -> []. all() -> [ - t_build_and_match_literals, - t_update_literals, t_match_and_update_literals, + t_build_and_match_literals, t_build_and_match_literals_large, + t_update_literals, t_update_literals_large, + t_match_and_update_literals, t_match_and_update_literals_large, t_update_map_expressions, - t_update_assoc,t_update_exact, - t_guard_bifs, t_guard_sequence, t_guard_update, - t_guard_receive,t_guard_fun, t_list_comprehension, - t_map_equal, + t_update_assoc, t_update_assoc_large, + t_update_exact, t_update_exact_large, + t_guard_bifs, + t_guard_sequence, t_guard_sequence_large, + t_guard_update, t_guard_update_large, + t_guard_receive, t_guard_receive_large, + t_guard_fun, t_list_comprehension, + t_update_deep, + t_map_equal, t_map_compare, t_map_sort_literals, %% Specific Map BIFs @@ -88,7 +120,11 @@ all() -> [ %% erlang t_erlang_hash, t_map_encode_decode, - t_map_size, + t_map_size, t_is_map, + + %% non specific BIF related + t_bif_build_and_check, + t_bif_merge_and_check, %% maps module t_maps_fold, t_maps_map, @@ -96,9 +132,17 @@ all() -> [ %% Other functions + t_hashmap_balance, + t_erts_internal_order, + t_erts_internal_hash, t_pdict, t_ets, - t_tracing + t_tracing, + + %% instruction-level tests + t_has_map_fields, + y_regs, + badmap_17 ]. groups() -> []. @@ -124,6 +168,9 @@ t_build_and_match_literals(Config) when is_list(Config) -> #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} = + id(#{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}), + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) @@ -145,17 +192,461 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), ok. +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0, + + 60 = map_size(M0), + 60 = maps:size(M0), + + % with repeating + M1 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10", + 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11", + 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + + 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13", + 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14", + + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }), + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + 60 = map_size(M1), + 60 = maps:size(M1), + + % with floats + + M2 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + 90 = map_size(M2), + 90 = maps:size(M2), + + % with bignums + M3 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + 36893488147419103232=>big1, 73786976294838206464=>big2, + 147573952589676412928=>big3, 18446744073709551616=>big4, + 4294967296=>big5, 8589934592=>big6, + 4294967295=>big7, 67108863=>big8 + }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + 98 = map_size(M3), + 98 = maps:size(M3), + + %% with maps + + M4 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M4, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4, + + + #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15", + #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := V4, + #{ third => small, map => key } := "small map key 3", + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4, + + a5 = V1, + "c5" = V2, + "e5" = V3, + "small map key 2" = V4, + "large map key 1" = V5, + + 95 = map_size(M4), + 95 = maps:size(M4), + + % call for value + + M5 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M5, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5, + + 95 = map_size(M5), + 95 = maps:size(M5), + + %% remember + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, -%% Tests size(Map). -%% not implemented, perhaps it shouldn't be either + ok. -%t_size(Config) when is_list(Config) -> -% 0 = size(#{}), -% 1 = size(#{a=>1}), -% 1 = size(#{a=>#{a=>1}}), -% 2 = size(#{a=>1, b=>2}), -% 3 = size(#{a=>1, b=>2, b=>"3"}), -% ok. t_map_size(Config) when is_list(Config) -> 0 = map_size(id(#{})), @@ -172,16 +663,108 @@ t_map_size(Config) when is_list(Config) -> true = map_is_size(M#{ "a" => 2}, 2), false = map_is_size(M#{ "c" => 2}, 2), + Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)], + ok = build_and_check_size(Ks,0,#{}), + + %% try deep collisions + %% statistically we get another subtree at 50k -> 100k elements + %% Try to be nice and don't use too much memory in the testcase, + + N = 500000, + Is = lists:seq(1,N), + N = map_size(maps:from_list([{I,I}||I<-Is])), + N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])), + N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])), + N = map_size(maps:from_list([{float(I),I}||I<-Is])), + %% Error cases. - {'EXIT',{badarg,_}} = (catch map_size([])), - {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), - {'EXIT',{badarg,_}} = (catch map_size(1)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), + ok. + +build_and_check_size([K|Ks],N,M0) -> + N = map_size(M0), + M1 = M0#{ K => K }, + build_and_check_size(Ks,N + 1,M1); +build_and_check_size([],N,M) -> + N = map_size(M), ok. map_is_size(M,N) when map_size(M) =:= N -> true; map_is_size(_,_) -> false. +t_is_map(Config) when is_list(Config) -> + true = is_map(#{}), + true = is_map(#{a=>1}), + false = is_map({a,b}), + false = is_map(x), + if is_map(#{}) -> ok end, + if is_map(#{b=>1}) -> ok end, + if not is_map([1,2,3]) -> ok end, + if not is_map(x) -> ok end, + ok. + % test map updates without matching +t_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + t_update_literals(Config) when is_list(Config) -> Map = #{x=>1,y=>2,z=>3,q=>4}, #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ @@ -189,13 +772,15 @@ t_update_literals(Config) when is_list(Config) -> ]), ok. + loop_update_literals_x_q(Map, []) -> Map; loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). % test map updates with matching t_match_and_update_literals(Config) when is_list(Config) -> - Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, + #{ "one" => small, map => key } => "small map key 1" }, #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ {1,2},{3,4},{5,6},{7,8} ]), @@ -209,8 +794,78 @@ t_match_and_update_literals(Config) when is_list(Config) -> #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, ok. +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(Map#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + + loop_match_and_update_literals_x_q(Map, []) -> Map; -loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> +loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0, + #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) -> loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). @@ -222,13 +877,17 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + Ks = lists:seq($a,$z), + #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } = + (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 }, - %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch (T)#{a:=42,b=>2}) + end), ok. - t_update_assoc(Config) when is_list(Config) -> M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), @@ -241,8 +900,75 @@ t_update_assoc(Config) when is_list(Config) -> M2 = M0#{3.0:=wrong,3.0=>new}, %% Errors cases. - BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + ok. + + +t_update_assoc_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1, + #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} = + M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{13.0=>new}, + #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2, + M2 = M0#{13.0:=wrong,13.0=>new}, ok. @@ -265,13 +991,122 @@ t_update_exact(Config) when is_list(Config) -> 1 := update2, 1.0 := new_val2, 1.0 => new_val3, 1.0 => new_val4 }, + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = id(#{}), + {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]}, + #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c], + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1, + + M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]}, + + M2 = M0#{13.0:=new}, + #{10:=a0,20:=b0,13.0:=new} = M2, + M2 = M0#{13.0=>wrong,13.0:=new}, %% Errors cases. - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. +t_update_deep(Config) when is_list(Config) -> + N = 250000, + M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]), + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + + M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + + M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + + M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3, + #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3, ok. t_guard_bifs(Config) when is_list(Config) -> @@ -303,12 +1138,82 @@ t_guard_sequence(Config) when is_list(Config) -> {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), - + %% error case {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), ok. +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. + + map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; @@ -328,6 +1233,66 @@ t_guard_update(Config) when is_list(Config) -> second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), ok. +t_guard_update_large(Config) when is_list(Config) -> + M0 = id(#{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 70.0=>fa0,80.0=>fb0,90.0=>"fc0", + 71.0=>fa1,81.0=>fb1,91.0=>"fc1", + 72.0=>fa2,82.0=>fb2,92.0=>"fc2", + 73.0=>fa3,83.0=>fb3,93.0=>"fc3", + 74.0=>fa4,84.0=>fb4,94.0=>"fc4", + + 75.0=>fa5,85.0=>fb5,95.0=>"fc5", + 76.0=>fa6,86.0=>fb6,96.0=>"fc6", + 77.0=>fa7,87.0=>fb7,97.0=>"fc7", + 78.0=>fa8,88.0=>fb8,98.0=>"fc8", + 79.0=>fa9,89.0=>fb9,99.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + error = map_guard_update(M0#{},M0#{}), + first = map_guard_update(M0#{},M0#{x=>first}), + second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}), + ok. + + map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; map_guard_update(_, _) -> error. @@ -357,6 +1322,42 @@ t_guard_receive(Config) when is_list(Config) -> done = call(Pid, done), ok. +-define(t_guard_receive_large_procs, 1500). + +t_guard_receive_large(Config) when is_list(Config) -> + M = lists:foldl(fun(_,#{procs := Ps } = M) -> + M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }} + end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)), + lists:foreach(fun(Pid) -> + Pid ! {self(), hello} + end, maps:keys(maps:get(procs,M))), + ok = guard_receive_large_loop(M), + ok. + +guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) -> + ok; +guard_receive_large_loop(M) -> + receive + #{pid := Pid, msg := hello} -> + case M of + #{done := Count, procs := #{Pid := 150}} -> + Pid ! {self(), done}, + guard_receive_large_loop(M#{done := Count + 1}); + #{procs := #{Pid := Count} = Ps} -> + Pid ! {self(), hello}, + guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}}) + end + end. + +grecv_loop() -> + receive + {_, done} -> + ok; + {Pid, hello} -> + Pid ! #{pid=>self(), msg=>hello}, + grecv_loop() + end. + call(Pid, M) -> Pid ! {self(), M}, receive {Pid, Res} -> Res end. @@ -387,6 +1388,11 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + + Ks = lists:seq($a,$z), + Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks], + [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms, + [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms), ok. t_guard_fun(Config) when is_list(Config) -> @@ -432,7 +1438,7 @@ t_map_sort_literals(Config) when is_list(Config) -> true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), - false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), false = #{ 1.0 => 1 } < id(#{ 1 => 1}), %% value order @@ -440,16 +1446,47 @@ t_map_sort_literals(Config) when is_list(Config) -> false = #{ a => 2 } < id(#{ a => 1}), false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + false = #{ a => 1 } < id(#{ a => 1.0}), + false = #{ a => 1.0 } < id(#{ a => 1}), true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), + %% large maps + + M = maps:from_list([{I,I}||I <- lists:seq(1,500)]), + + %% size order + true = M#{ a => 1, b => 2} < id(M#{ a => 1, b => 1, c => 1}), + true = M#{ b => 1, a => 1} < id(M#{ c => 1, a => 1, b => 1}), + false = M#{ c => 1, b => 1, a => 1} < id(M#{ c => 1, a => 1}), + + %% key order + true = M#{ a => 1 } < id(M#{ b => 1}), + false = M#{ b => 1 } < id(M#{ a => 1}), + true = M#{ a => 1, b => 1, c => 1 } < id(M#{ b => 1, c => 1, d => 1}), + true = M#{ b => 1, c => 1, d => 1 } > id(M#{ a => 1, b => 1, c => 1}), + true = M#{ c => 1, b => 1, a => 1 } < id(M#{ b => 1, c => 1, d => 1}), + true = M#{ "a" => 1 } < id(M#{ <<"a">> => 1}), + false = M#{ <<"a">> => 1 } < id(#{ "a" => 1}), + true = M#{ 1 => 1 } < id(maps:remove(1,M#{ 1.0 => 1})), + false = M#{ 1.0 => 1 } < id(M#{ 1 => 1}), + + %% value order + true = M#{ a => 1 } < id(M#{ a => 2}), + false = M#{ a => 2 } < id(M#{ a => 1}), + false = M#{ a => 2, b => 1 } < id(M#{ a => 1, b => 3}), + true = M#{ a => 1, b => 1 } < id(M#{ a => 1, b => 3}), + false = M#{ a => 1 } < id(M#{ a => 1.0}), + false = M#{ a => 1.0 } < id(M#{ a => 1}), + + true = M#{ "a" => "hi", b => 134 } == id(M#{ b => 134,"a" => "hi"}), + %% lists:sort SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), - ok. t_map_equal(Config) when is_list(Config) -> @@ -469,27 +1506,292 @@ t_map_equal(Config) when is_list(Config) -> true = id(#{ a => 1, b => 3, c => <<"wat">> }) =:= id(#{ a => 1, b => 3, c=><<"wat">>}), ok. + +t_map_compare(Config) when is_list(Config) -> + 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, []), + repeat(100, fun(_) -> recursive_compare() end, []), + ok. + +float_int_compare() -> + Terms = numeric_keys(3), + %%io:format("Keys to use: ~p\n", [Terms]), + Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms), + lists:foreach(fun(Size) -> + MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end, + repeat(100, fun do_compare/1, [MapGen, MapGen]) + end, + lists:seq(1,length(Terms))), + ok. + +numeric_keys(N) -> + lists:foldl(fun(_,Acc) -> + Int = random:uniform(N*4) - N*2, + Float = float(Int), + [Int, Float, Float * 0.99, Float * 1.01 | Acc] + end, + [], + lists:seq(1,N)). + + +repeat(0, _, _) -> + ok; +repeat(N, Fun, Arg) -> + Fun(Arg), + repeat(N-1, Fun, Arg). + +copy_term(T) -> + Papa = self(), + P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end), + P ! T, + receive R -> R end. + +do_compare([Gen1, Gen2]) -> + M1 = Gen1(), + M2 = Gen2(), + %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]), + C = (M1 < M2), + Erlang = maps_lessthan(M1, M2), + C = Erlang, + ?CHECK(M1==M1, M1), + + %% Change one key from int to float (or vice versa) and check compare + ML1 = maps:to_list(M1), + {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1), + case K1 of + I when is_integer(I) -> + case maps:find(float(I),M1) of + error -> + M1f = maps:remove(I, maps:put(float(I), V1, M1)), + ?CHECK(M1f > M1, [M1f, M1]); + _ -> ok + end; + + F when is_float(F), round(F) == F -> + case maps:find(round(F),M1) of + error -> + M1i = maps:remove(F, maps:put(round(F), V1, M1)), + ?CHECK(M1i < M1, [M1i, M1]); + _ -> ok + end; + + _ -> ok % skip floats with decimals + end, + + ?CHECK(M2 == M2, [M2]). + + +maps_lessthan(M1, M2) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case erts_internal:cmp_term(K1,K2) of + -1 -> true; + 0 -> (V1 < V2); + 1 -> false + end; + + {S1, S2} -> + S1 < S2 + end. + +term_sort(L) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end, + L). + + +cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) -> + case {size(T1),size(T2)} of + {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact); + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end; + +cmp([H1|T1], [H2|T2], Exact) -> + case cmp(H1,H2, Exact) of + 0 -> cmp(T1,T2, Exact); + C -> C + end; + +cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) -> + cmp_maps(M1,M2,Exact); +cmp(M1, M2, Exact) -> + cmp_others(M1, M2, Exact). + +cmp_maps(M1, M2, Exact) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case cmp(K1, K2, true) of + 0 -> cmp(V1, V2, Exact); + C -> C + end; + + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end. + +cmp_others(I, F, true) when is_integer(I), is_float(F) -> + -1; +cmp_others(F, I, true) when is_float(F), is_integer(I) -> + 1; +cmp_others(T1, T2, _) -> + case {T1<T2, T1==T2} of + {true,false} -> -1; + {false,true} -> 0; + {false,false} -> 1 + end. + +map_gen(Pairs, Size) -> + {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> + KI = random:uniform(size(Keys)), + K = element(KI,Keys), + KV = element(random:uniform(size(K)), K), + {erlang:delete_element(KI,Keys), [KV | Acc]} + end, + {Pairs, []}, + lists:seq(1,Size)), + + maps:from_list(L). + + +recursive_compare() -> + Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()}, + {A, B} = term_gen_recursive(Leafs, 0, 0), + %%io:format("Recursive term A = ~p\n", [A]), + %%io:format("Recursive term B = ~p\n", [B]), + + ?CHECK({true,false} =:= case do_cmp(A, B, false) of + -1 -> {A<B, A>=B}; + 0 -> {A==B, A/=B}; + 1 -> {A>B, A=<B} + end, + {A,B}), + A2 = copy_term(A), + ?CHECK(A == A2, {A,A2}), + ?CHECK(0 =:= cmp(A, A2, false), {A,A2}), + + B2 = copy_term(B), + ?CHECK(B == B2, {B,B2}), + ?CHECK(0 =:= cmp(B, B2, false), {B,B2}), + ok. + +do_cmp(A, B, Exact) -> + C = cmp(A, B, Exact), + C. + +%% Generate two terms {A,B} that may only differ +%% at float vs integer types. +term_gen_recursive(Leafs, Flags, Depth) -> + MaxDepth = 10, + Rnd = case {Flags, Depth} of + {_, MaxDepth} -> % Only leafs + random:uniform(size(Leafs)) + 3; + {0, 0} -> % Only containers + random:uniform(3); + {0,_} -> % Anything + random:uniform(size(Leafs)+3) + end, + case Rnd of + 1 -> % Make map + Size = random:uniform(size(Leafs)), + lists:foldl(fun(_, {Acc1,Acc2}) -> + {K1,K2} = term_gen_recursive(Leafs, Flags, + Depth+1), + {V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1), + %%ok = check_keys(K1,K2, 0), + {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)} + end, + {maps:new(), maps:new()}, + lists:seq(1,Size)); + 2 -> % Make cons + {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1), + {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), + {[Car1 | Cdr1], [Car2 | Cdr2]}; + 3 -> % Make tuple + Size = random:uniform(size(Leafs)), + L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, + lists:seq(1,Size)), + {L1, L2} = lists:unzip(L), + {list_to_tuple(L1), list_to_tuple(L2)}; + + N -> % Make leaf + case element(N-3, Leafs) of + I when is_integer(I) -> + case random:uniform(4) of + 1 -> {I, float(I)}; + 2 -> {float(I), I}; + _ -> {I,I} + end; + T -> {T,T} + end + end. + +check_keys(K1, K2, _) when K1 =:= K2 -> + case erlang:phash3(K1) =:= erlang:phash3(K2) of + true -> ok; + false -> + io:format("Same keys with different hash values !!!\nK1 = ~p\nK2 = ~p\n", [K1,K2]), + error + end; +check_keys(K1, K2, 0) -> + case {erlang:phash3(K1), erlang:phash3(K2)} of + {H,H} -> check_keys(K1, K2, 1); + {_,_} -> ok + end; +check_keys(K1, K2, L) when L < 10 -> + case {erlang:phash3([L|K1]), erlang:phash3([L|K2])} of + {H,H} -> check_keys(K1, K2, L+1); + {_,_} -> ok + end; +check_keys(K1, K2, L) -> + io:format("Same hash value at level ~p !!!\nK1 = ~p\nK2 = ~p\n", [L,K1,K2]), + error. + %% BIFs t_bif_map_get(Config) when is_list(Config) -> - + %% small map 1 = maps:get(a, #{ a=> 1}), 2 = maps:get(b, #{ a=> 1, b => 2}), "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), - M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), - "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }), + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}), - %% error case - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])), - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})), + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = maps:get(a, M1), + 2 = maps:get(b, M1), + "hi" = maps:get("hello", M1), + "tuple hi" = maps:get({1,1.0}, M1), + "v3" = maps:get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + (catch maps:get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + (catch maps:get(a, #{b=>1, c=>2})), ok. t_bif_map_find(Config) when is_list(Config) -> - + %% small map {ok, 1} = maps:find(a, #{ a=> 1}), {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), {ok, "int"} = maps:find(1, #{ 1 => "int"}), @@ -498,8 +1800,18 @@ t_bif_map_find(Config) when is_list(Config) -> {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), - M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), - {ok, "v4"} = maps:find(<<"k2">>, M#{ <<"k2">> => "v4" }), + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + {ok, 1} = maps:find(a, M1), + {ok, 2} = maps:find(b, M1), + {ok, "hi"} = maps:find("hello", M1), + {ok, "tuple hi"} = maps:find({1,1.0}, M1), + {ok, "v3"} = maps:find(<<"k2">>, M1), %% error case error = maps:find(a,#{}), @@ -508,9 +1820,10 @@ t_bif_map_find(Config) when is_list(Config) -> error = maps:find(1, #{ 1.0 => "float"}), error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key - - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))), - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} = + (catch maps:find(a, T)) + end), ok. @@ -535,26 +1848,27 @@ t_bif_map_is_key(Config) when is_list(Config) -> false = maps:is_key(1.0, maps:put(1, "number", M1)), %% error case - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))), - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + (catch maps:is_key(a, T)) + end), ok. t_bif_map_keys(Config) when is_list(Config) -> [] = maps:keys(#{}), - [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, - [4,int,"hi",<<"key">>] = maps:keys(M1), + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), %% error case - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} = + (catch maps:keys(T)) + end), ok. t_bif_map_new(Config) when is_list(Config) -> @@ -582,11 +1896,58 @@ t_bif_map_merge(Config) when is_list(Config) -> #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), - %% error case - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), + %% try deep collisions + N = 150000, + Is = lists:seq(1,N), + M2 = maps:from_list([{I,I}||I<-Is]), + 150000 = maps:size(M2), + M3 = maps:from_list([{<<I:32>>,I}||I<-Is]), + 150000 = maps:size(M3), + M4 = maps:merge(M2,M3), + 300000 = maps:size(M4), + M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]), + 150000 = maps:size(M5), + M6 = maps:merge(M4,M5), + 450000 = maps:size(M6), + M7 = maps:from_list([{float(I),I}||I<-Is]), + 150000 = maps:size(M7), + M8 = maps:merge(M7,M6), + 600000 = maps:size(M8), + + #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8, + #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8, + #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8, + #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8, + #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8, + #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8, + + %% overlapping + M8 = maps:merge(M2,M8), + M8 = maps:merge(M3,M8), + M8 = maps:merge(M4,M8), + M8 = maps:merge(M5,M8), + M8 = maps:merge(M6,M8), + M8 = maps:merge(M7,M8), + M8 = maps:merge(M8,M8), + + %% maps:merge/2 and mixed + + Ks1 = [764492191,2361333849], %% deep collision + Ks2 = lists:seq(1,33), + M9 = maps:from_list([{K,K}||K <- Ks1]), + M10 = maps:from_list([{K,K}||K <- Ks2]), + M11 = maps:merge(M9,M10), + ok = check_keys_exist(Ks1 ++ Ks2, M11), + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(#{}, T)), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, #{})), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, T)) + end), ok. @@ -596,41 +1957,48 @@ t_bif_map_put(Config) when is_list(Config) -> M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), - ["hi"] = maps:keys(M1), - ["hello"] = maps:values(M1), + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), M2 = #{ int := 3 } = maps:put(int, 3, M1), - [int,"hi"] = maps:keys(M2), - [3,"hello"] = maps:values(M2), + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), - [int,"hi",<<"key">>] = maps:keys(M3), - [3,"hello",<<"value">>] = maps:values(M3), + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), - [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), - [wat,3,"hello",<<"value">>] = maps:values(M4), + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), - [number,wat,3,"hello",<<"value">>] = maps:values(M5), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), - [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), %% error case - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), - ok. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} = + (catch maps:put(1, a, T)) + end), + ok. + +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). + +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). t_bif_map_remove(Config) when is_list(Config) -> 0 = erlang:map_size(maps:remove(some_key, #{})), @@ -639,20 +2007,20 @@ t_bif_map_remove(Config) when is_list(Config) -> 4 => number, 18446744073709551629 => wat}, M1 = maps:remove("hi", M0), - [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), - [number,wat,3,<<"value">>] = maps:values(M1), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), M2 = maps:remove(int, M1), - [4,18446744073709551629,<<"key">>] = maps:keys(M2), - [number,wat,<<"value">>] = maps:values(M2), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), M3 = maps:remove(<<"key">>, M2), - [4,18446744073709551629] = maps:keys(M3), - [number,wat] = maps:values(M3), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), M4 = maps:remove(18446744073709551629, M3), - [4] = maps:keys(M4), - [number] = maps:values(M4), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), M5 = maps:remove(4, M4), [] = maps:keys(M5), @@ -664,11 +2032,10 @@ t_bif_map_remove(Config) when is_list(Config) -> #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), %% error case - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = + (catch maps:remove(a, T)) + end), ok. t_bif_map_update(Config) when is_list(Config) -> @@ -691,10 +2058,10 @@ t_bif_map_update(Config) when is_list(Config) -> 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), %% error case - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)), - + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, T)) + end), ok. @@ -702,21 +2069,29 @@ t_bif_map_update(Config) when is_list(Config) -> t_bif_map_values(Config) when is_list(Config) -> [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), - [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), - % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, - [number,3,"hello2",<<"value2">>] = maps:values(M2), - [number,3,"hello",<<"value">>] = maps:values(M1), + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), + + Vs = lists:seq(1000,20000), + M3 = maps:from_list([{K,K}||K<-Vs]), + M4 = maps:merge(M1,M3), + M5 = maps:merge(M2,M3), + true = is_members(Vs,maps:values(M3)), + true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)), + true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)), %% error case - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} = + (catch maps:values(T)) + end), ok. t_erlang_hash(Config) when is_list(Config) -> @@ -730,61 +2105,61 @@ t_erlang_hash(Config) when is_list(Config) -> t_bif_erlang_phash2() -> 39679005 = erlang:phash2(#{}), - 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), - 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), - 14363616 = erlang:phash2(#{ 1 => a }), - 51612236 = erlang:phash2(#{ a => 1 }), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 - 37468437 = erlang:phash2(#{{} => <<>>}), - 44049159 = erlang:phash2(#{<<>> => {}}), + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 118679416 = erlang:phash2(M0), - 51612236 = erlang:phash2(M1), - 118679416 = erlang:phash2(M2), + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 ok. t_bif_erlang_phash() -> Sz = 1 bsl 32, - 268440612 = erlang:phash(#{},Sz), - 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 1394238263 = erlang:phash(#{ 1 => a },Sz), - 4066388227 = erlang:phash(#{ a => 1 },Sz), + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 - 1578050717 = erlang:phash(#{{} => <<>>},Sz), - 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 3590546636 = erlang:phash(M0,Sz), - 4066388227 = erlang:phash(M1,Sz), - 3590546636 = erlang:phash(M2,Sz), + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. t_bif_erlang_hash() -> Sz = 1 bsl 27 - 1, - 5158 = erlang:hash(#{},Sz), - 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 126071654 = erlang:hash(#{ 1 => a },Sz), - 126426236 = erlang:hash(#{ a => 1 },Sz), + 39684169 = erlang:hash(#{},Sz), % 5158 + 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 + 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 + 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 + 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 - 101655720 = erlang:hash(#{{} => <<>>},Sz), - 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 + 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 38260486 = erlang:hash(M0,Sz), - 126426236 = erlang:hash(M1,Sz), - 38260486 = erlang:hash(M2,Sz), + 70254632 = erlang:hash(M0,Sz), % 38260486 + 59623150 = erlang:hash(M1,Sz), % 126426236 + 70254632 = erlang:hash(M2,Sz), % 38260486 ok. @@ -818,14 +2193,35 @@ t_map_encode_decode(Config) when is_list(Config) -> %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, - 107,0,2,104,105, % "hi" :: list() + 107,0,2,104,105, % "hi" :: list() 107,0,5,118,97,108,117,101, % "value" :: list() - 100,0,1,97, % a :: atom() - 97,33, % 33 :: integer() - 100,0,1,98, % b :: atom() - 97,55 % 55 :: integer() + 100,0,1,97, % a :: atom() + 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() + 97,55 % 55 :: integer() >>), + %% Maps of different sizes + lists:foldl(fun(Key, M0) -> + M1 = M0#{Key => Key}, + case Key rem 17 of + 0 -> + M1 = binary_to_term(term_to_binary(M1)); + _ -> + ok + end, + M1 + end, + #{}, + lists:seq(1,10000)), + + %% many maps in same binary + MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end, + [#{}], + lists:seq(1,100)), + MapList = binary_to_term(term_to_binary(MapList)), + MapListR = lists:reverse(MapList), + MapListR = binary_to_term(term_to_binary(MapListR)), %% error cases %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> @@ -856,43 +2252,48 @@ t_map_encode_decode(Config) when is_list(Config) -> map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> M1 = maps:put(K,V,M0), B0 = erlang:term_to_binary(M1), - Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), - %% sort Ks and Vs according to term spec, then match it - KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), - ok = match_encoded_map(B0, length(Ls), KVbins), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), %% decode and match it M1 = erlang:binary_to_term(B0), map_encode_decode_and_match(Pairs,Ls,M1); map_encode_decode_and_match([],_,_) -> ok. match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> - match_encoded_map(Encoded,Items); + match_encoded_map_stripped_size(Encoded,Items,Items); match_encoded_map(_,_,_) -> no_match_size. -match_encoded_map(<<>>,[]) -> ok; -match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> - Size = erlang:byte_size(Item), - <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, - EncodedTerm = Item, %% Asssert - match_encoded_map(Bin1,Items). +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. t_bif_map_to_list(Config) when is_list(Config) -> [] = maps:to_list(#{}), - [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}), - [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), - [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), - [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, - <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}), + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), %% error cases - {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), - {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))), + do_badmap(fun(T) -> + {'EXIT', {{badmap,T},_}} = + (catch maps:to_list(T)) + end), ok. @@ -901,7 +2302,7 @@ t_bif_map_from_list(Config) when is_list(Config) -> A = maps:from_list([]), 0 = erlang:map_size(A), - #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), @@ -914,6 +2315,13 @@ t_bif_map_from_list(Config) when is_list(Config) -> maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + %% repeated keys (large -> small) + Ps1 = [{a,I}|| I <- lists:seq(1,32)], + Ps2 = [{a,I}|| I <- lists:seq(33,64)], + + M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2), + #{ a := 64, b := 1, c := 1 } = M, + %% error cases {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},b]))), {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},{b,b,3}]))), @@ -923,6 +2331,140 @@ t_bif_map_from_list(Config) when is_list(Config) -> {'EXIT', {badarg,_}} = (catch maps:from_list(id(42))), ok. +t_bif_build_and_check(Config) when is_list(Config) -> + ok = check_build_and_remove(750,[ + fun(K) -> [K,K] end, + fun(K) -> [float(K),K] end, + fun(K) -> K end, + fun(K) -> {1,K} end, + fun(K) -> {K} end, + fun(K) -> [K|K] end, + fun(K) -> [K,1,2,3,4] end, + fun(K) -> {K,atom} end, + fun(K) -> float(K) end, + fun(K) -> integer_to_list(K) end, + fun(K) -> list_to_atom(integer_to_list(K)) end, + fun(K) -> [K,{K,[K,{K,[K]}]}] end, + fun(K) -> <<K:32>> end + ]), + + ok. + +check_build_and_remove(_,[]) -> ok; +check_build_and_remove(N,[F|Fs]) -> + {M,Ks} = build_and_check(N, maps:new(), F, []), + ok = remove_and_check(Ks,M), + check_build_and_remove(N,Fs). + +build_and_check(0, M0, _, Ks) -> {M0, Ks}; +build_and_check(N, M0, F, Ks) -> + K = build_key(F,N), + M1 = maps:put(K,K,M0), + ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1), + M2 = maps:update(K,v,M1), + v = maps:get(K,M2), + build_and_check(N-1,M1,F,[{K,M1}|Ks]). + +remove_and_check([],_) -> ok; +remove_and_check([{K,Mc}|Ks], M0) -> + K = maps:get(K,M0), + true = maps:is_key(K,M0), + true = Mc =:= M0, + true = M0 == Mc, + M1 = maps:remove(K,M0), + false = M1 =:= Mc, + false = Mc == M1, + false = maps:is_key(K,M1), + true = maps:is_key(K,M0), + ok = check_keys_exist([I||{I,_} <- Ks],M1), + error = maps:find(K,M1), + remove_and_check(Ks, M1). + +build_key(F,N) when N rem 3 =:= 0 -> F(N); +build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K}; +build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K]. + +check_keys_exist([], _) -> ok; +check_keys_exist([K|Ks],M) -> + true = maps:is_key(K,M), + check_keys_exist(Ks,M). + +t_bif_merge_and_check(Config) when is_list(Config) -> + %% simple disjunct ones + %% make sure all keys are unique + Kss = [[a,b,c,d], + [1,2,3,4], + [], + ["hi"], + [e], + [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)], + lists:seq(5, 28), + lists:seq(29, 59), + [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)], + [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)], + [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]], + + + KsMs = build_keys_map_pairs(Kss), + Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs], + ok = merge_and_check_combo(Cs), + + %% overlapping ones + + KVs1 = [{a,1},{b,2},{c,3}], + KVs2 = [{b,3},{c,4},{d,5}], + KVs = [{I,I} || I <- lists:seq(1,32)], + KVs3 = KVs1 ++ KVs, + KVs4 = KVs2 ++ KVs, + + M1 = maps:from_list(KVs1), + M2 = maps:from_list(KVs2), + M3 = maps:from_list(KVs3), + M4 = maps:from_list(KVs4), + + M12 = maps:merge(M1,M2), + ok = check_key_values(KVs2 ++ [{a,1}], M12), + M21 = maps:merge(M2,M1), + ok = check_key_values(KVs1 ++ [{d,5}], M21), + + M34 = maps:merge(M3,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M34), + M43 = maps:merge(M4,M3), + ok = check_key_values(KVs3 ++ [{d,5}], M43), + + M14 = maps:merge(M1,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M14), + M41 = maps:merge(M4,M1), + ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41), + + ok. + +check_key_values([],_) -> ok; +check_key_values([{K,V}|KVs],M) -> + V = maps:get(K,M), + check_key_values(KVs,M). + +merge_and_check_combo([]) -> ok; +merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) -> + M12 = maps:merge(M1,M2), + ok = check_keys_exist(Ks1 ++ Ks2, M12), + M21 = maps:merge(M2,M1), + ok = check_keys_exist(Ks1 ++ Ks2, M21), + + true = M12 =:= M21, + M12 = M21, + + merge_and_check_combo(Cs). + +build_keys_map_pairs([]) -> []; +build_keys_map_pairs([Ks|Kss]) -> + M = maps:from_list(keys_to_pairs(Ks)), + ok = check_keys_exist(Ks, M), + [{Ks,M}|build_keys_map_pairs(Kss)]. + +keys_to_pairs(Ks) -> [{K,K} || K <- Ks]. + + %% Maps module, not BIFs t_maps_fold(_Config) -> Vs = lists:seq(1,100), @@ -960,6 +2502,128 @@ t_maps_without(_Config) -> %% MISC + +%% Verify that the the number of nodes in hashmaps +%% of different types and sizes does not deviate too +%% much from the theoretical model. +t_hashmap_balance(_Config) -> + io:format("Integer keys\n", []), + hashmap_balance(fun(I) -> I end), + io:format("Float keys\n", []), + hashmap_balance(fun(I) -> float(I) end), + io:format("String keys\n", []), + hashmap_balance(fun(I) -> integer_to_list(I) end), + io:format("Binary (big) keys\n", []), + hashmap_balance(fun(I) -> <<I:16/big>> end), + io:format("Binary (little) keys\n", []), + hashmap_balance(fun(I) -> <<I:16/little>> end), + io:format("Atom keys\n", []), + erts_debug:set_internal_state(available_internal_state, true), + hashmap_balance(fun(I) -> erts_debug:get_internal_state({atom,I}) end), + erts_debug:set_internal_state(available_internal_state, false), + + ok. + +hashmap_balance(KeyFun) -> + F = fun(I, {M0,Max0}) -> + Key = KeyFun(I), + M1 = M0#{Key => Key}, + Max1 = case erts_internal:map_type(M1) of + hashmap -> + Nodes = hashmap_nodes(M1), + Avg = maps:size(M1) * 0.4, + StdDev = math:sqrt(maps:size(M1)) / 3, + SD_diff = abs(Nodes - Avg) / StdDev, + %%io:format("~p keys: ~p nodes avg=~p SD_diff=~p\n", + %% [maps:size(M1), Nodes, Avg, SD_diff]), + {MaxDiff0, _} = Max0, + case {Nodes > Avg, SD_diff > MaxDiff0} of + {true, true} -> {SD_diff, M1}; + _ -> Max0 + end; + + flatmap -> Max0 + end, + {M1, Max1} + end, + + {_,{MaxDiff,MaxMap}} = lists:foldl(F, + {#{}, {0, 0}}, + lists:seq(1,10000)), + io:format("Max std dev diff ~p for map of size ~p (nodes=~p, flatsize=~p)\n", + [MaxDiff, maps:size(MaxMap), hashmap_nodes(MaxMap), erts_debug:flat_size(MaxMap)]), + + true = (MaxDiff < 6), % The probability of this line failing is about 0.000000001 + % for a uniform hash. I've set the probability this "high" for now + % to detect flaws in our make_internal_hash. + % Hard limit is 15 (see hashmap_over_estimated_heap_size). + ok. + +hashmap_nodes(M) -> + Info = erts_debug:map_info(M), + lists:foldl(fun(Tpl,Acc) -> + case element(1,Tpl) of + bitmaps -> Acc + element(2,Tpl); + arrays -> Acc + element(2,Tpl); + _ -> Acc + end + end, + 0, + Info). + +t_erts_internal_order(_Config) when is_list(_Config) -> + + -1 = erts_internal:cmp_term(1,2), + 1 = erts_internal:cmp_term(2,1), + 0 = erts_internal:cmp_term(2,2), + + + -1 = erts_internal:cmp_term(1,a), + 1 = erts_internal:cmp_term(a,1), + 0 = erts_internal:cmp_term(a,a), + + -1 = erts_internal:cmp_term(1,1.0), + 1 = erts_internal:cmp_term(1.0,1), + 0 = erts_internal:cmp_term(1.0,1.0), + + -1 = erts_internal:cmp_term(1,1 bsl 65), + 1 = erts_internal:cmp_term(1 bsl 65,1), + 0 = erts_internal:cmp_term(1 bsl 65, 1 bsl 65), + + -1 = erts_internal:cmp_term(1 bsl 65,float(1)), + 1 = erts_internal:cmp_term(float(1),1 bsl 65), + -1 = erts_internal:cmp_term(1,float(1 bsl 65)), + 1 = erts_internal:cmp_term(float(1 bsl 65),1), + 0 = erts_internal:cmp_term(float(1 bsl 65), float(1 bsl 65)), + + %% reported errors + -1 = erts_internal:cmp_term(0,2147483648), + 0 = erts_internal:cmp_term(2147483648,2147483648), + 1 = erts_internal:cmp_term(2147483648,0), + + M = #{0 => 0,2147483648 => 0}, + true = M =:= binary_to_term(term_to_binary(M)), + + F1 = fun(_, _) -> 0 end, + F2 = fun(_, _) -> 1 end, + M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]), + M1 = maps:merge(M0, #{0 => 1}), + 8 = maps:size(M1), + 1 = maps:get(0,M1), + ok. + +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + + M1 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + ok. + t_pdict(_Config) -> put(#{ a => b, b => a},#{ c => d}), @@ -1086,5 +2750,111 @@ trace_collector(Msg,Parent) -> Parent ! Msg, Parent. +t_has_map_fields(Config) when is_list(Config) -> + true = has_map_fields_1(#{one=>1}), + true = has_map_fields_1(#{one=>1,two=>2}), + false = has_map_fields_1(#{two=>2}), + false = has_map_fields_1(#{}), + + true = has_map_fields_2(#{c=>1,b=>2,a=>3}), + true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}), + false = has_map_fields_2(#{b=>2,c=>1}), + false = has_map_fields_2(#{x=>y}), + false = has_map_fields_2(#{}), + + true = has_map_fields_3(#{c=>1,b=>2,a=>3}), + true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}), + true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{[]=>42,42.0=>43}), + false = has_map_fields_3(#{b=>2,c=>1}), + false = has_map_fields_3(#{[]=>y}), + false = has_map_fields_3(#{42.0=>x,a=>99}), + false = has_map_fields_3(#{}), + + ok. + +has_map_fields_1(#{one:=_}) -> true; +has_map_fields_1(#{}) -> false. + +has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true; +has_map_fields_2(#{}) -> false. + +has_map_fields_3(#{a:=_,b:=_}) -> true; +has_map_fields_3(#{[]:=_,42.0:=_}) -> true; +has_map_fields_3(#{}) -> false. + +y_regs(Config) when is_list(Config) -> + Val = [length(Config)], + Map0 = y_regs_update(#{}, Val), + Map2 = y_regs_update(Map0, Val), + + Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]), + Map4 = y_regs_update(Map3, Val), + + true = is_map(Map2) andalso is_map(Map4), + + ok. + +y_regs_update(Map0, Val0) -> + Val1 = {t,Val0}, + K1 = id({key,1}), + K2 = id({key,2}), + Map1 = Map0#{K1=>K1, + a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0, + f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0, + k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0, + p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0, + u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0, + z=>Val0, + aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0, + af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0, + ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0, + ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0, + au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0, + az=>Val0, + K2=>[a,b,c]}, + Map2 = Map1#{K1=>K1, + a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1, + f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1, + k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1, + p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1, + u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1, + z:=Val1, + aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1, + af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1, + ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1, + ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1, + au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1, + az:=Val1, + K2=>[a,b,c]}, + + %% Traverse the maps to validate them. + _ = erlang:phash2({Map1,Map2}, 100000), + + _ = id({K1,K2,Val0,Val1}), %Force use of Y registers. + Map2. + +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/id(-1), + <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. + +%% Test that a module compiled with the OTP 17 compiler will +%% generate the correct 'badmap' exception. +badmap_17(Config) -> + case ?MODULE of + map_SUITE -> do_badmap_17(Config); + _ -> {skip,"Run in map_SUITE"} + end. + +do_badmap_17(Config) -> + Mod = badmap_17, + DataDir = test_server:lookup_config(data_dir, Config), + Beam = filename:join(DataDir, Mod), + {module,Mod} = code:load_abs(Beam), + do_badmap(fun Mod:update/1). + %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam Binary files differnew file mode 100644 index 0000000000..277fc34b94 --- /dev/null +++ b/erts/emulator/test/map_SUITE_data/badmap_17.beam diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.erl b/erts/emulator/test/map_SUITE_data/badmap_17.erl new file mode 100644 index 0000000000..0ec65e0e33 --- /dev/null +++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl @@ -0,0 +1,26 @@ +-module(badmap_17). +-export([update/1]). + +%% Compile this source file with OTP 17. + +update(Map) -> + try + update_1(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end, + try + update_2(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end. + +update_1(M) -> + M#{a=>42}. + +update_2(M) -> + M#{a:=42}. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index fc4a5028e1..d3c884689f 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -924,8 +924,51 @@ maps(Config) when is_list(Config) -> table), {ok,#{foo := 3},[],[]} = erlang:match_spec_test({}, [{{},[],[#{foo => {'+',1,2}}]}], table), + + {ok,"camembert",[],[]} = + erlang:match_spec_test(#{b => "camembert",c => "cabécou"}, + [{#{b => '$1',c => "cabécou"},[],['$1']}], table), + + {ok,#{a :="camembert",b := "hi"},[],[]} = + erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>}, + [{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}], + table), + %% large maps + + Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)], + M0 = maps:from_list(Ls0), + M1 = #{a=>1,b=>2,c=>3,d=>4}, + + R1 = M0#{263 := #{ a=> 3 }}, + Ms1 = [{M1#{c:='$1'},[],[M0#{263 := #{a => '$1'}}]}], + + {ok,R1,[],[]} = erlang:match_spec_test(M1,Ms1,table), + + Ms2 = [{M0#{63:='$1', 19:='$2'},[],[M0#{19:='$1', 63:='$2'}]}], + R2 = M0#{63 := maps:get(19,M0), 19 := maps:get(63,M0) }, + {ok,R2,[],[]} = erlang:match_spec_test(M0,Ms2,table), + + ok = maps_check_loop(M1), + ok = maps_check_loop(M0), + M2 = maps:from_list([{integer_to_list(K),V} || {K,V} <- Ls0]), + ok = maps_check_loop(M2), ok. +maps_check_loop(M) -> + Ks = maps:keys(M), + maps_check_loop(M,M,M,M,Ks,lists:reverse(Ks),1). + +maps_check_loop(Orig,M0,MsM0,Rm0,[K|Ks],[Rk|Rks],Ix) -> + MsK = list_to_atom([$$]++integer_to_list(Ix)), + MsM1 = MsM0#{K := MsK}, + Rm1 = Rm0#{Rk := MsK}, + M1 = M0#{Rk := maps:get(K,MsM0)}, + Ms = [{MsM1,[],[Rm1]}], + {ok,M1,[],[]} = erlang:match_spec_test(Orig,Ms,table), + maps_check_loop(Orig,M1,MsM1,Rm1,Ks,Rks,Ix+1); +maps_check_loop(_,_,_,_,[],[],_) -> ok. + + empty_list(Config) when is_list(Config) -> Val=[{'$1',[], [{message,'$1'},{message,{caller}},{return_trace}]}], %% Did crash debug VM in faulty assert: 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 aec59867d8..dc215b1529 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -26,7 +26,8 @@ case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1, demon_2/1, demon_3/1, demonitor_flush/1, local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1, - large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1]). + large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1, + monitor_time_offset/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -38,7 +39,8 @@ all() -> [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, demon_1, mon_1, mon_2, demon_2, demon_3, demonitor_flush, {group, remove_monitor}, large_exit, - list_cleanup, mixer, named_down, otp_5827]. + list_cleanup, mixer, named_down, otp_5827, + monitor_time_offset]. groups() -> [{remove_monitor, [], @@ -59,7 +61,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(15)), - [{watchdog, Dog}|Config]. + [{watchdog, Dog},{testcase, Func}|Config]. end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), @@ -761,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 @@ -837,6 +837,89 @@ otp_5827(Config) when is_list(Config) -> ?line ?t:fail("erlang:monitor/2 hangs") end. +monitor_time_offset(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+C single_time_warp"), + Me = self(), + PMs = lists:map(fun (_) -> + Pid = spawn(Node, + fun () -> + check_monitor_time_offset(Me) + end), + {Pid, erlang:monitor(process, Pid)} + end, + lists:seq(1, 100)), + lists:foreach(fun ({P, _M}) -> + P ! check_no_change_message + end, PMs), + lists:foreach(fun ({P, M}) -> + receive + {no_change_message_received, P} -> + ok; + {'DOWN', M, process, P, Reason} -> + ?t:fail(Reason) + end + end, PMs), + preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + lists:foreach(fun ({P, M}) -> + receive + {change_messages_received, P} -> + erlang:demonitor(M, [flush]); + {'DOWN', M, process, P, Reason} -> + ?t:fail(Reason) + end + end, PMs), + stop_node(Node), + ok. + +check_monitor_time_offset(Leader) -> + Mon1 = erlang:monitor(time_offset, clock_service), + Mon2 = erlang:monitor(time_offset, clock_service), + Mon3 = erlang:monitor(time_offset, clock_service), + Mon4 = erlang:monitor(time_offset, clock_service), + + erlang:demonitor(Mon2, [flush]), + + Mon5 = erlang:monitor(time_offset, clock_service), + Mon6 = erlang:monitor(time_offset, clock_service), + Mon7 = erlang:monitor(time_offset, clock_service), + + receive check_no_change_message -> ok end, + receive + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) + after 0 -> + Leader ! {no_change_message_received, self()} + end, + receive after 100 -> ok end, + erlang:demonitor(Mon4, [flush]), + receive + {'CHANGE', Mon3, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', Mon6, time_offset, clock_service, _} -> + ok + end, + erlang:demonitor(Mon5, [flush]), + receive + {'CHANGE', Mon7, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', Mon1, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) + after 1000 -> + ok + end, + Leader ! {change_messages_received, self()}. + +%% +%% ... +%% wait_for_m(_,_,0) -> exit(monitor_wait_timeout); @@ -959,3 +1042,25 @@ generate(_Fun, 0) -> []; generate(Fun, N) -> [Fun() | generate(Fun, N-1)]. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) -> + TestCase = ?config(testcase, Config), + PA = filename:dirname(code:which(?MODULE)), + ESTime = erlang:monotonic_time(1) + erlang:time_offset(1), + Unique = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(TestCase) + ++ "-" + ++ integer_to_list(ESTime) + ++ "-" + ++ integer_to_list(Unique)), + test_server:start_node(Name, + slave, + [{args, "-pa " ++ PA ++ " " ++ Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). 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 4560077a51..c35c71dd5b 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -39,7 +39,8 @@ get_length/1, make_atom/1, make_string/1, reverse_list_test/1, otp_9828/1, otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, - dirty_nif_exception/1, nif_schedule/1 + dirty_nif_exception/1, nif_schedule/1, + nif_exception/1, nif_nan_and_inf/1, nif_atom_too_long/1 ]). -export([many_args_100/100]). @@ -68,7 +69,8 @@ all() -> make_string,reverse_list_test, otp_9828, otp_9668, consume_timeslice, - nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception + nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, + nif_exception, nif_nan_and_inf, nif_atom_too_long ]. groups() -> @@ -451,7 +453,7 @@ maps(Config) when is_list(Config) -> M = maps_from_list_nif(Pairs), R = {RIs,Is} = sorted_list_from_maps_nif(M), io:format("Pairs: ~p~nMap: ~p~nReturned: ~p~n", [lists:sort(Pairs),M,R]), - Is = lists:sort(Pairs), + true = (lists:sort(Is) =:= lists:sort(Pairs)), Is = lists:reverse(RIs), #{} = maps_from_list_nif([]), @@ -1188,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]), @@ -1595,11 +1599,27 @@ dirty_nif_exception(Config) when is_list(Config) -> N when is_integer(N) -> ensure_lib_loaded(Config), try - call_dirty_nif_exception(), + %% this checks that the expected exception + %% occurs when the NIF returns the result + %% of enif_make_badarg directly + call_dirty_nif_exception(1), ?t:fail(expected_badarg) catch error:badarg -> - [{?MODULE,call_dirty_nif_exception,[],_}|_] = + [{?MODULE,call_dirty_nif_exception,[1],_}|_] = + erlang:get_stacktrace(), + ok + end, + try + %% this checks that the expected exception + %% occurs when the NIF calls enif_make_badarg + %% at some point but then returns a value that + %% isn't an exception + call_dirty_nif_exception(0), + ?t:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[0],_}|_] = erlang:get_stacktrace(), ok end @@ -1608,6 +1628,57 @@ dirty_nif_exception(Config) when is_list(Config) -> {skipped,"No dirty scheduler support"} end. +nif_exception(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + call_nif_exception(), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end. + +nif_nan_and_inf(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + call_nif_nan_or_inf(nan), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end, + try + call_nif_nan_or_inf(inf), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end, + try + call_nif_nan_or_inf(tuple), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end. + +nif_atom_too_long(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + call_nif_atom_too_long(all), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end, + try + call_nif_atom_too_long(len), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end. + next_msg(_Pid) -> receive M -> M @@ -1741,8 +1812,11 @@ consume_timeslice_nif(_,_) -> ?nif_stub. call_nif_schedule(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. send_from_dirty_nif(_) -> ?nif_stub. -call_dirty_nif_exception() -> ?nif_stub. +call_dirty_nif_exception(_) -> ?nif_stub. call_dirty_nif_zero_args() -> ?nif_stub. +call_nif_exception() -> ?nif_stub. +call_nif_nan_or_inf(_) -> ?nif_stub. +call_nif_atom_too_long(_) -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 85544db2ab..3cc9f51ef8 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -380,7 +380,8 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifSInt64 sint64; ErlNifUInt64 uint64; double d; - ERL_NIF_TERM atom, ref1, ref2; + ERL_NIF_TERM atom, ref1, ref2, term; + size_t len; sint = INT_MIN; do { @@ -502,6 +503,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ goto error; } } + ref1 = enif_make_ref(env); ref2 = enif_make_ref(env); if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2) @@ -890,6 +892,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T ERL_NIF_TERM badarg = enif_make_badarg(env); if (enif_is_exception(env, error_atom)) return error_atom; if (!enif_is_exception(env, badarg)) return error_atom; + if (!enif_has_pending_exception(env)) return error_atom; return badarg; } @@ -1608,16 +1611,26 @@ static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_ static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { switch (argc) { - case 0: { + case 1: { ERL_NIF_TERM args[255]; int i; - for (i = 0; i < 255; i++) + args[0] = argv[0]; + for (i = 1; i < 255; i++) args[i] = enif_make_int(env, i); return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, call_dirty_nif_exception, 255, argv); } - case 1: - return enif_make_badarg(env); + case 2: { + int return_badarg_directly; + enif_get_int(env, argv[0], &return_badarg_directly); + assert(return_badarg_directly == 1 || return_badarg_directly == 0); + if (return_badarg_directly) + return enif_make_badarg(env); + else { + /* ignore return value */ enif_make_badarg(env); + return enif_make_atom(env, "ok"); + } + } default: return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, call_dirty_nif_exception, argc-1, argv); @@ -1637,6 +1650,82 @@ static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL } #endif +/* + * Call enif_make_badarg, but don't return its return value. Instead, + * return ok. Result should still be a badarg exception for the erlang + * caller. + */ +static ERL_NIF_TERM call_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* ignore return value */ enif_make_badarg(env); + return enif_make_atom(env, "ok"); +} + +#if !defined(NAN) || !defined(INFINITY) +double zero(void) +{ + return 0.0; +} +#endif + +static ERL_NIF_TERM call_nif_nan_or_inf(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + double val; + char arg[6]; + ERL_NIF_TERM res; + + assert(argc == 1); + enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1); + if (strcmp(arg, "nan") == 0) { + /* Verify that enif_make_double raises a badarg for NaN */ +#ifdef NAN + val = NAN; +#else + val = 0.0/zero(); +#endif + } else { + /* Verify that enif_make_double raises a badarg for NaN and infinity */ +#ifdef INFINITY + val = INFINITY; +#else + val = 1.0/zero(); +#endif + } + res = enif_make_double(env, val); + assert(enif_is_exception(env, res)); + assert(enif_has_pending_exception(env)); + if (strcmp(arg, "tuple") == 0) { + return enif_make_tuple2(env, argv[0], res); + } else { + return res; + } +} + +static ERL_NIF_TERM call_nif_atom_too_long(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + char str[257]; + char arg[4]; + size_t len; + int i; + ERL_NIF_TERM res; + + assert(argc == 1); + enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1); + /* Verify that creating an atom from a string that's too long results in a badarg */ + for (i = 0; i < sizeof str; ++i) { + str[i] = 'a'; + } + str[256] = '\0'; + if (strcmp(arg, "len") == 0) { + len = strlen(str); + res = enif_make_atom_len(env, str, len); + } else { + res = enif_make_atom(env, str); + } + assert(enif_is_exception(env, res)); + return res; +} + static ERL_NIF_TERM is_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { return enif_make_int(env, enif_is_map(env,argv[0])); @@ -1717,8 +1806,9 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_int(env, __LINE__); cnt = 0; + next_ret = 1; while(enif_map_iterator_get_pair(env,&iter_f,&key,&value)) { - if (cnt && !next_ret) + if (!next_ret) return enif_make_int(env, __LINE__); list_f = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_f); next_ret = enif_map_iterator_next(env,&iter_f); @@ -1731,8 +1821,9 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_int(env, __LINE__); cnt = 0; + prev_ret = 1; while(enif_map_iterator_get_pair(env,&iter_b,&key,&value)) { - if (cnt && !prev_ret) + if (!prev_ret) return enif_make_int(env, __LINE__); /* Test that iter_f can step "backwards" */ @@ -1744,6 +1835,7 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER list_b = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_b); prev_ret = enif_map_iterator_prev(env,&iter_b); + cnt++; } if (cnt) { @@ -1818,9 +1910,12 @@ static ErlNifFunc nif_funcs[] = #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT {"call_dirty_nif", 3, call_dirty_nif}, {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, - {"call_dirty_nif_exception", 0, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND}, #endif + {"call_nif_exception", 0, call_nif_exception}, + {"call_nif_nan_or_inf", 1, call_nif_nan_or_inf}, + {"call_nif_atom_too_long", 1, call_nif_atom_too_long}, {"is_map_nif", 1, is_map_nif}, {"get_map_size_nif", 1, get_map_size_nif}, {"make_new_map_nif", 0, make_new_map_nif}, diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 3f9b339ed2..2f505893b4 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -686,6 +686,9 @@ timer_refc(doc) -> "as they should for data stored in bif timers."]; timer_refc(suite) -> []; timer_refc(Config) when is_list(Config) -> + {skipped, "Test needs to be UPDATED for new timer implementation"}. + +timer_refc_test(Config) when is_list(Config) -> ?line RNode = {get_nodename(), 1}, ?line RPid = mk_pid(RNode, 4711, 2), ?line RPort = mk_port(RNode, 4711), @@ -1117,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/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 8cf8377c30..abe5b8eb91 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -441,7 +441,11 @@ t_string_to_integer(Config) when is_list(Config) -> {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, {"111z11111111",16}]), - + + %% log2 calculation overflow bug in do_integer_to_list (OTP-12624) + %% Would crash with segv + 0 = list_to_integer(lists:duplicate(10000000,$0)), + ok. test_sti(Num) -> 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/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index f439867e9c..0c5b09d45a 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -24,7 +24,7 @@ init_per_group/2,end_per_group/2, command/1, command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1, port_info1/1, port_info2/1, - port_info_os_pid/1, + port_info_os_pid/1, port_info_race/1, connect/1, control/1, echo_to_busy/1]). -export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]). @@ -42,7 +42,8 @@ all() -> groups() -> [{command_e, [], [command_e_1, command_e_2, command_e_3, command_e_4]}, - {port_info, [], [port_info1, port_info2, port_info_os_pid]}]. + {port_info, [], + [port_info1, port_info2, port_info_os_pid, port_info_race]}]. init_per_suite(Config) -> Config. @@ -254,6 +255,28 @@ do_port_info_os_pid() -> true = erlang:port_close(P), ok. +port_info_race(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Program = filename:join(DataDir, "port_test"), + Top = self(), + P1 = open_port({spawn,Program}, [{packet,1}]), + P2 = open_port({spawn,Program}, [{packet,1}]), + Info1 = erlang:port_info(P1), + Info2 = erlang:port_info(P2), + F = fun Loop(Port, _, 0) -> + Top ! {ok,Port}; + Loop(Port, Info, N) -> + Info = erlang:port_info(Port), + Loop(Port, Info, N - 1) + end, + spawn_link(fun () -> F(P1, Info1, 1000) end), + spawn_link(fun () -> F(P2, Info2, 1000) end), + receive {ok,P1} -> ok end, + receive {ok,P2} -> ok end, + true = erlang:port_close(P1), + true = erlang:port_close(P2), + ok. + output_test(_, _, Input, Output) when Output > 16#1fffffff -> io:format("~p bytes received\n", [Input]); output_test(P, Bin, Input0, Output0) -> 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 a0a8a9c42c..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 @@ -34,7 +35,15 @@ bad_univ_to_local/1, bad_local_to_univ/1, univ_to_seconds/1, seconds_to_univ/1, consistency/1, - now_unique/1, now_update/1, timestamp/1]). + 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]). + +-export([init_per_testcase/2, end_per_testcase/2]). -export([local_to_univ_utc/1]). @@ -56,6 +65,12 @@ -define(dst_timezone, 2). +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + [{testcase, Func}|Config]. + +end_per_testcase(_Func, Config) -> + ok. + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> @@ -63,7 +78,13 @@ all() -> bad_univ_to_local, bad_local_to_univ, univ_to_seconds, seconds_to_univ, consistency, - {group, now}, timestamp]. + {group, now}, timestamp, + time_warp_modes, + monotonic_time_monotonicity, + monotonic_time_monotonicity_parallel, + time_unit_conversion, + signed_time_unit_conversion, + erlang_timestamp]. groups() -> [{now, [], [now_unique, now_update]}]. @@ -420,6 +441,440 @@ now_update1(N) when N > 0 -> now_update1(0) -> ?line test_server:fail(). +time_warp_modes(Config) when is_list(Config) -> + %% All time warp modes always supported in + %% combination with no time correction... + check_time_warp_mode(Config, false, no_time_warp), + check_time_warp_mode(Config, false, single_time_warp), + check_time_warp_mode(Config, false, multi_time_warp), + + erts_debug:set_internal_state(available_internal_state, true), + try + case erts_debug:get_internal_state({check_time_config, + true, no_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, no_time_warp) + end, + case erts_debug:get_internal_state({check_time_config, + true, single_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, single_time_warp) + end, + case erts_debug:get_internal_state({check_time_config, + true, multi_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, multi_time_warp) + end + after + erts_debug:set_internal_state(available_internal_state, false) + end. + +check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) -> + io:format("~n~n~n***** Testing TimeCorrection=~p TimeWarpMode=~p *****~n", + [TimeCorrection, TimeWarpMode]), + Mon = erlang:monitor(time_offset, clock_service), + _ = erlang:time_offset(), + Start = erlang:monotonic_time(1000), + MonotonicityTimeout = 2000, + {ok, Node} = start_node(Config, + "+c " ++ atom_to_list(TimeCorrection) + ++ " +C " ++ atom_to_list(TimeWarpMode)), + StartTime = rpc:call(Node, erlang, system_info, [start_time]), + Me = self(), + MonotincityTestStarted = make_ref(), + MonotincityTestDone = make_ref(), + spawn_link(Node, + fun () -> + Me ! MonotincityTestStarted, + cmp_times(erlang:start_timer(MonotonicityTimeout, + self(), + timeout), + erlang:monotonic_time()), + Me ! MonotincityTestDone + end), + receive MonotincityTestStarted -> ok end, + check_time_offset(Node, TimeWarpMode), + TimeWarpMode = rpc:call(Node, erlang, system_info, [time_warp_mode]), + TimeCorrection = rpc:call(Node, erlang, system_info, [time_correction]), + receive MonotincityTestDone -> ok end, + MonotonicTime = rpc:call(Node, erlang, monotonic_time, []), + MonotonicTimeUnit = rpc:call(Node, + erlang, + convert_time_unit, + [1, seconds, native]), + UpMilliSeconds = erlang:convert_time_unit(MonotonicTime - StartTime, + MonotonicTimeUnit, + milli_seconds), + io:format("UpMilliSeconds=~p~n", [UpMilliSeconds]), + End = erlang:monotonic_time(milli_seconds), + stop_node(Node), + try + true = (UpMilliSeconds > (98*MonotonicityTimeout) div 100), + true = (UpMilliSeconds < (102*(End-Start)) div 100) + catch + error:_ -> + io:format("Uptime inconsistency", []), + case {TimeCorrection, erlang:system_info(time_correction)} of + {true, true} -> + ?t:fail(uptime_inconsistency); + {true, false} -> + _ = erlang:time_offset(), + receive + {'CHANGE', Mon, time_offset, clock_service, _} -> + ignore + after 1000 -> + ?t:fail(uptime_inconsistency) + end; + _ -> + ignore + end + end, + erlang:demonitor(Mon, [flush]), + ok. + +check_time_offset(Node, no_time_warp) -> + final = rpc:call(Node, erlang, system_info, [time_offset]), + final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + final = rpc:call(Node, erlang, system_info, [time_offset]); +check_time_offset(Node, single_time_warp) -> + preliminary = rpc:call(Node, erlang, system_info, [time_offset]), + preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + final = rpc:call(Node, erlang, system_info, [time_offset]), + final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]); +check_time_offset(Node, multi_time_warp) -> + volatile = rpc:call(Node, erlang, system_info, [time_offset]), + volatile = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + volatile = rpc:call(Node, erlang, system_info, [time_offset]). + +monotonic_time_monotonicity(Config) when is_list(Config) -> + Done = erlang:start_timer(10000,self(),timeout), + cmp_times(Done, erlang:monotonic_time()). + +cmp_times(Done, X0) -> + X1 = erlang:monotonic_time(), + X2 = erlang:monotonic_time(), + X3 = erlang:monotonic_time(), + X4 = erlang:monotonic_time(), + X5 = erlang:monotonic_time(), + true = (X0 =< X1), + true = (X1 =< X2), + true = (X2 =< X3), + true = (X3 =< X4), + true = (X4 =< X5), + receive + {timeout, Done, timeout} -> + ok + after 0 -> + 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) -> + Mon = erlang:monitor(time_offset, clock_service), + start_check_res_convs(Mon, 1000000000000), + start_check_res_convs(Mon, 2333333333333), + start_check_res_convs(Mon, 5732678356789), + erlang:demonitor(Mon, [flush]). + +start_check_res_convs(Mon, Res) -> + io:format("Checking ~p time_unit~n", [Res]), + check_res_convs(Mon, + erlang:start_timer(?CHK_RES_CONVS_TIMEOUT, + self(), + timeout), + Res). + + +check_res_convs(Mon, Done, Res) -> + receive + {timeout, Done, timeout} -> + case Res div 10 of + 0 -> + ok; + NewRes -> + start_check_res_convs(Mon, NewRes) + end + after 0 -> + do_check_res_convs(Mon, Done, Res) + end. + +do_check_res_convs(Mon, Done, Res) -> + TStart = erlang:monotonic_time(), + T = erlang:monotonic_time(Res), + TEnd = erlang:monotonic_time(), + TMin = erlang:convert_time_unit(TStart, native, Res), + TMax = erlang:convert_time_unit(TEnd, native, Res), + %io:format("~p =< ~p =< ~p~n", [TMin, T, TEnd]), + true = (TMin =< T), + true = (TMax >= T), + check_time_offset_res_conv(Mon, Res), + check_res_convs(Mon, Done, Res). + + +check_time_offset_res_conv(Mon, Res) -> + TORes = erlang:time_offset(Res), + TO = erlang:time_offset(), + case erlang:convert_time_unit(TO, native, Res) of + TORes -> + ok; + TORes2 -> + case check_time_offset_change(Mon, TO, 1000) of + {TO, false} -> + ?t:fail({time_unit_conversion_inconsistency, + TO, TORes, TORes2}); + {_NewTO, true} -> + ?t:format("time_offset changed", []), + check_time_offset_res_conv(Mon, Res) + end + end. + +signed_time_unit_conversion(Config) when is_list(Config) -> + chk_strc(1000000000, 1000000), + chk_strc(1000000000, 1000), + chk_strc(1000000000, 1), + chk_strc(1000000, 1000), + chk_strc(1000000, 1), + chk_strc(1000, 1), + chk_strc(4711, 17), + chk_strc(1 bsl 10, 1), + chk_strc(1 bsl 16, 10), + chk_strc(1 bsl 17, 1 bsl 8), + chk_strc((1 bsl 17) + 1, (1 bsl 8) - 1), + chk_strc(1 bsl 17, 11), + ok. + +chk_strc(Res0, Res1) -> + case (Res0 /= Res1) andalso (Res0 =< 1000000) andalso (Res1 =< 1000000) of + true -> + {FromRes, ToRes} = case Res0 > Res1 of + true -> {Res0, Res1}; + false -> {Res1, Res0} + end, + MinFromValuesPerToValue = FromRes div ToRes, + MaxFromValuesPerToValue = ((FromRes-1) div ToRes)+1, + io:format("~p -> ~p [~p, ~p]~n", + [FromRes, ToRes, + MinFromValuesPerToValue, MaxFromValuesPerToValue]), + chk_values_per_value(FromRes, ToRes, + -10*FromRes, 10*FromRes, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + undefined, MinFromValuesPerToValue); + _ -> + ok + end, + chk_random_values(Res0, Res1), + chk_random_values(Res1, Res0), + ok. + +chk_random_values(FR, TR) -> +% case (FR rem TR == 0) orelse (TR rem FR == 0) of +% true -> + io:format("rand values ~p -> ~p~n", [FR, TR]), + random:seed(268438039, 268440479, 268439161), + Values = lists:map(fun (_) -> random:uniform(1 bsl 65) - (1 bsl 64) end, + lists:seq(1, 100000)), + CheckFun = fun (V) -> + CV = erlang:convert_time_unit(V, FR, TR), + case {(FR*CV) div TR =< V, + (FR*(CV+1)) div TR >= V} of + {true, true} -> + ok; + Failure -> + ?t:fail({Failure, CV, V, FR, TR}) + end + end, + lists:foreach(CheckFun, Values).%; +% false -> ok +% end. + + +chk_values_per_value(_FromRes, _ToRes, + EndValue, EndValue, + MinFromValuesPerToValue, MaxFromValuesPerToValue, + _ToValue, FromValueCount) -> +% io:format("~p [~p]~n", [EndValue, FromValueCount]), + case ((MinFromValuesPerToValue =< FromValueCount) + andalso (FromValueCount =< MaxFromValuesPerToValue)) of + false -> + ?t:fail({MinFromValuesPerToValue, + FromValueCount, + MaxFromValuesPerToValue}); + true -> + ok + end; +chk_values_per_value(FromRes, ToRes, Value, EndValue, + MinFromValuesPerToValue, MaxFromValuesPerToValue, + ToValue, FromValueCount) -> + case erlang:convert_time_unit(Value, FromRes, ToRes) of + ToValue -> + chk_values_per_value(FromRes, ToRes, + Value+1, EndValue, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + ToValue, FromValueCount+1); + NewToValue -> + case ((MinFromValuesPerToValue =< FromValueCount) + andalso (FromValueCount =< MaxFromValuesPerToValue)) of + false -> + ?t:fail({MinFromValuesPerToValue, + FromValueCount, + MaxFromValuesPerToValue}); + true -> +% io:format("~p -> ~p [~p]~n", +% [Value, NewToValue, FromValueCount]), + chk_values_per_value(FromRes, ToRes, + Value+1, EndValue, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + NewToValue, 1) + end + end. + +erlang_timestamp(Config) when is_list(Config) -> + Mon = erlang:monitor(time_offset, clock_service), + {TO, _} = check_time_offset_change(Mon, + erlang:time_offset(), + 0), + Done = erlang:start_timer(10000,self(),timeout), + ok = check_erlang_timestamp(Done, Mon, TO). + +check_erlang_timestamp(Done, Mon, TO) -> + receive + {timeout, Done, timeout} -> + erlang:demonitor(Mon, [flush]), + ok + after 0 -> + do_check_erlang_timestamp(Done, Mon, TO) + end. + +do_check_erlang_timestamp(Done, Mon, TO) -> + MinMon = erlang:monotonic_time(), + {MegaSec, Sec, MicroSec} = erlang:timestamp(), + MaxMon = erlang:monotonic_time(), + TsMin = erlang:convert_time_unit(MinMon+TO, + native, + micro_seconds), + TsMax = erlang:convert_time_unit(MaxMon+TO, + native, + micro_seconds), + TsTime = (MegaSec*1000000+Sec)*1000000+MicroSec, + case (TsMin =< TsTime) andalso (TsTime =< TsMax) of + true -> + NewTO = case erlang:time_offset() of + TO -> + TO; + _ -> + check_time_offset_change(Mon, TO, 0) + end, + check_erlang_timestamp(Done, Mon, NewTO); + false -> + io:format("TsMin=~p TsTime=~p TsMax=~p~n", [TsMin, TsTime, TsMax]), + ?t:format("Detected inconsistency; " + "checking for time_offset change...", []), + case check_time_offset_change(Mon, TO, 1000) of + {TO, false} -> + ?t:fail(timestamp_inconsistency); + {NewTO, true} -> + ?t:format("time_offset changed", []), + check_erlang_timestamp(Done, Mon, NewTO) + end + end. + +check_time_offset_change(Mon, TO, Wait) -> + process_changed_time_offset(Mon, TO, false, Wait). + +process_changed_time_offset(Mon, TO, Changed, Wait) -> + receive + {'CHANGE', Mon, time_offset, clock_service, NewTO} -> + process_changed_time_offset(Mon, NewTO, true, Wait) + after Wait -> + case erlang:time_offset() of + TO -> + {TO, Changed}; + _OtherTO -> + receive + {'CHANGE', Mon, time_offset, clock_service, NewTO} -> + process_changed_time_offset(Mon, NewTO, true, Wait) + end + end + end. + + + %% Returns the test data: a list of {Utc, Local} tuples. test_data() -> @@ -554,4 +1009,25 @@ bad_dates() -> {{1996, 4, 30}, {12, 0, -1}}, % Sec {{1996, 4, 30}, {12, 0, 60}}]. - + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) -> + TestCase = ?config(testcase, Config), + PA = filename:dirname(code:which(?MODULE)), + ESTime = erlang:monotonic_time(1) + erlang:time_offset(1), + Unique = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(TestCase) + ++ "-" + ++ integer_to_list(ESTime) + ++ "-" + ++ integer_to_list(Unique)), + test_server:start_node(Name, + slave, + [{args, "-pa " ++ PA ++ " " ++ Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index c28224729d..3701dd8437 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -232,12 +232,16 @@ read_timer(Config) when is_list(Config) -> cleanup(doc) -> []; cleanup(suite) -> []; cleanup(Config) when is_list(Config) -> + {skipped, "Test needs to be UPDATED for new timer implementation"}. + +cleanup_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Timer on dead process ?line P1 = spawn(fun () -> ok end), ?line wait_until(fun () -> process_is_cleaned_up(P1) end), ?line T1 = erlang:start_timer(10000, P1, "hej"), ?line T2 = erlang:send_after(10000, P1, "hej"), + receive after 1000 -> ok end, ?line Mem = mem(), ?line false = erlang:read_timer(T1), ?line false = erlang:read_timer(T2), @@ -250,6 +254,7 @@ cleanup(Config) when is_list(Config) -> ?line true = is_integer(erlang:read_timer(T3)), ?line true = is_integer(erlang:read_timer(T4)), ?line wait_until(fun () -> process_is_cleaned_up(P2) end), + receive after 1000 -> ok end, ?line false = erlang:read_timer(T3), ?line false = erlang:read_timer(T4), ?line Mem = mem(), @@ -418,6 +423,9 @@ evil_recv_timeouts(TOs, N, M) -> registered_process(doc) -> []; registered_process(suite) -> []; registered_process(Config) when is_list(Config) -> + {skipped, "Test needs to be UPDATED for new timer implementation"}. + +registered_process_test(Config) when is_list(Config) -> ?line Mem = mem(), %% Cancel ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), @@ -455,10 +463,18 @@ registered_process(Config) when is_list(Config) -> ?line ok. mem() -> - AA = erlang:system_info(allocated_areas), - {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA), - Mem. - + TSrvs = erts_internal:get_bif_timer_servers(), + lists:foldl(fun (Tab, Sz) -> + case lists:member(ets:info(Tab, owner), TSrvs) of + true -> + ets:info(Tab, memory) + Sz; + false -> + Sz + end + end, + 0, + ets:all())*erlang:system_info({wordsize,external}). + process_is_cleaned_up(P) when is_pid(P) -> undefined == erts_debug:get_internal_state({process_status, P}). @@ -486,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/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl new file mode 100644 index 0000000000..5ad6e59272 --- /dev/null +++ b/erts/emulator/test/unique_SUITE.erl @@ -0,0 +1,390 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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 +%% 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(unique_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([unique_monotonic_integer_white_box/1, + unique_integer_white_box/1]). + +-include_lib("test_server/include/test_server.hrl"). + +%-define(P(V), V). +-define(P(V), print_ret_val(?FILE, ?LINE, V)). + +-define(PRINT(V), print_ret_val(?FILE, ?LINE, V)). + + +init_per_testcase(Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(2)), + [{watchdog, Dog}, {testcase, Case}|Config]. + +end_per_testcase(_, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [unique_monotonic_integer_white_box, + unique_integer_white_box]. + +groups() -> + []. + +init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + Config. + +end_per_suite(_Config) -> + erts_debug:set_internal_state(available_internal_state, false), + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% +%% +%% Unique counter white box test case +%% +%% + +unique_monotonic_integer_white_box(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + TestServer = self(), + Success = make_ref(), + %% Run this in a separate node, so we don't mess up + %% the system when moving the strict monotonic counter + %% around in a non-strict monotonic way... + Test = spawn(Node, + fun () -> + unique_monotonic_integer_white_box_test(TestServer, Success) + end), + Mon = erlang:monitor(process, Test), + receive + {'DOWN', Mon, process, Test, Error} -> + ?t:fail(Error); + Success -> + ok + end, + erlang:demonitor(Mon, [flush]), + stop_node(Node), + ok. + +set_unique_monotonic_integer_state(MinCounter, NextValue) -> + true = erts_debug:set_internal_state(unique_monotonic_integer_state, + NextValue-MinCounter-1). + + + +unique_monotonic_integer_white_box_test(TestServer, Success) -> + erts_debug:set_internal_state(available_internal_state, true), + + WordSize = erlang:system_info({wordsize, internal}), + SmallBits = WordSize*8 - 4, + + MinSmall = -1*(1 bsl (SmallBits-1)), + MaxSmall = (1 bsl (SmallBits-1))-1, + %% Make sure we got small sizes correct... + 0 = erts_debug:size(MinSmall), + false = 0 =:= erts_debug:size(MinSmall-1), + 0 = erts_debug:size(MaxSmall), + false = 0 =:= erts_debug:size(MaxSmall+1), + + ?PRINT({min_small, MinSmall}), + ?PRINT({max_small, MaxSmall}), + + MinSint64 = -1*(1 bsl 63), + MaxSint64 = (1 bsl 63)-1, + + ?PRINT({min_Sint64, MinSint64}), + ?PRINT({max_Sint64, MaxSint64}), + + MinCounter = erts_debug:get_internal_state(min_unique_monotonic_integer), + MaxCounter = MinCounter + (1 bsl 64) - 1, + + ?PRINT({min_counter, MinCounter}), + ?PRINT({max_counter, MaxCounter}), + + case WordSize of + 4 -> + MinCounter = MinSint64; + 8 -> + MinCounter = MinSmall + end, + + StartState = erts_debug:get_internal_state(unique_monotonic_integer_state), + + %% Verify that we get expected results over all internal limits... + + case MinCounter < MinSmall of + false -> + 8 = WordSize, + ok; + true -> + 4 = WordSize, + ?PRINT(over_min_small), + set_unique_monotonic_integer_state(MinCounter, MinSmall-2), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 2), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 1), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 1), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 2), + garbage_collect(), + ok + end, + + ?PRINT(over_zero), %% Not really an interesting limit, but... + set_unique_monotonic_integer_state(MinCounter, -2), + true = (?P(erlang:unique_integer([monotonic])) == -2), + true = (?P(erlang:unique_integer([monotonic])) == -1), + true = (?P(erlang:unique_integer([monotonic])) == 0), + true = (?P(erlang:unique_integer([monotonic])) == 1), + true = (?P(erlang:unique_integer([monotonic])) == 2), + garbage_collect(), + + ?PRINT(over_max_small), + set_unique_monotonic_integer_state(MinCounter, MaxSmall-2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 2), + garbage_collect(), + + case MaxCounter > MaxSint64 of + false -> + 4 = WordSize, + ok; + true -> + 8 = WordSize, + ?PRINT(over_max_sint64), + set_unique_monotonic_integer_state(MinCounter, MaxSint64-2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 2), + garbage_collect() + end, + + ?PRINT(over_max_min_counter), + set_unique_monotonic_integer_state(MinCounter, if MaxCounter == MaxSint64 -> + MaxCounter-2; + true -> + MinCounter-3 + end), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 1), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 2), + garbage_collect(), + + %% Restore initial state and hope we didn't mess it up for the + %% system... + true = erts_debug:set_internal_state(unique_monotonic_integer_state, + StartState), + + TestServer ! Success. + +%% +%% +%% Unique integer white box test case +%% +%% + +-record(uniqint_info, {min_int, + max_int, + max_small, + schedulers, + sched_bits}). + +unique_integer_white_box(Config) when is_list(Config) -> + UinqintInfo = init_uniqint_info(), + #uniqint_info{min_int = MinInt, + max_int = MaxInt, + max_small = MaxSmall} = UinqintInfo, + io:format("****************************************************~n", []), + io:format("*** Around MIN_UNIQ_INT ~p ***~n", [MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around(MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 0 ***~n", []), + io:format("****************************************************~n", []), + check_unique_integer_around(0, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around MAX_SMALL ~p ***~n", [MaxSmall]), + io:format("****************************************************~n", []), + check_unique_integer_around(MaxSmall, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64+MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)+MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64)+MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64 ~p~n", [(1 bsl 64)]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64), UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64-MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)-MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64)-MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around MAX_UNIQ_INT ~p ***~n", [MaxInt]), + io:format("****************************************************~n", []), + check_unique_integer_around(MaxInt, UinqintInfo), + ok. + + +%%% Internal unique_integer_white_box/1 test case + +calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift -> + Shift; +calc_sched_bits(NoScheds, Shift) -> + calc_sched_bits(NoScheds, Shift+1). + +init_uniqint_info() -> + SmallBits = erlang:system_info({wordsize, internal})*8-4, + io:format("SmallBits=~p~n", [SmallBits]), + Schedulers = erlang:system_info(schedulers), + io:format("Schedulers=~p~n", [Schedulers]), + MinSmall = -1*(1 bsl (SmallBits-1)), + io:format("MinSmall=~p~n", [MinSmall]), + MaxSmall = (1 bsl (SmallBits-1))-1, + io:format("MaxSmall=~p~n", [MaxSmall]), + SchedBits = calc_sched_bits(Schedulers, 0), + io:format("SchedBits=~p~n", [SchedBits]), + MaxInt = ((((1 bsl 64) - 1) bsl SchedBits) bor Schedulers) + MinSmall, + io:format("MaxInt=~p~n", [MaxInt]), + #uniqint_info{min_int = MinSmall, + max_int = MaxInt, + max_small = MaxSmall, + schedulers = Schedulers, + sched_bits = SchedBits}. + +valid_uniqint(Int, #uniqint_info{min_int = MinInt} = UinqintInfo) when Int < MinInt -> + valid_uniqint(MinInt, UinqintInfo); +valid_uniqint(Int, #uniqint_info{min_int = MinInt, + sched_bits = SchedBits, + schedulers = Scheds}) -> + Int1 = Int - MinInt, + {Inc, ThreadNo} = case Int1 band ((1 bsl SchedBits) - 1) of + TN when TN > Scheds -> + {1, Scheds}; + TN -> + {0, TN} + end, + Counter = ((Int1 bsr SchedBits) + Inc) rem (1 bsl 64), + ((Counter bsl SchedBits) bor ThreadNo) + MinInt. + +smaller_valid_uniqint(Int, UinqintInfo) -> + Cand = Int-1, + case valid_uniqint(Cand, UinqintInfo) of + RI when RI < Int -> + RI; + _ -> + smaller_valid_uniqint(Cand, UinqintInfo) + end. + +int32_to_bigendian_list(Int) -> + 0 = Int bsr 32, + [(Int bsr 24) band 16#ff, + (Int bsr 16) band 16#ff, + (Int bsr 8) band 16#ff, + Int band 16#ff]. + +mk_uniqint(Int, #uniqint_info {min_int = MinInt, + sched_bits = SchedBits} = _UinqintInfo) -> + Int1 = Int - MinInt, + ThrId = Int1 band ((1 bsl SchedBits) - 1), + Value = (Int1 bsr SchedBits) band ((1 bsl 64) - 1), + 0 = Int1 bsr (SchedBits + 64), + NodeName = atom_to_list(node()), + Make = {make_unique_integer, ThrId, Value}, + %% erlang:display(Make), + Res = erts_debug:get_internal_state(Make), + %% erlang:display({uniq_int, Res}), + Res. + +check_uniqint(Int, UinqintInfo) -> + UniqInt = mk_uniqint(Int, UinqintInfo), + io:format("UniqInt=~p ", [UniqInt]), + case UniqInt =:= Int of + true -> + io:format("OK~n~n", []); + false -> + io:format("result UniqInt=~p FAILED~n", [UniqInt]), + exit(badres) + end. + +check_unique_integer_around(Int, #uniqint_info{min_int = MinInt, + max_int = MaxInt} = UinqintInfo) -> + {Start, End} = case {Int =< MinInt+100, Int >= MaxInt-100} of + {true, false} -> + {MinInt, MinInt+100}; + {false, false} -> + {smaller_valid_uniqint(Int-100, UinqintInfo), + valid_uniqint(Int+100, UinqintInfo)}; + {false, true} -> + {MaxInt-100, MaxInt} + end, + lists:foldl(fun (I, OldRefInt) -> + RefInt = valid_uniqint(I, UinqintInfo), + case OldRefInt =:= RefInt of + true -> + ok; + false -> + check_uniqint(RefInt, UinqintInfo) + end, + RefInt + end, + none, + lists:seq(Start, End)). + + +%% helpers + +print_ret_val(File, Line, Value) -> + io:format("~s:~p: ~p~n", [File, Line, Value]), + Value. + +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 = erlang:monotonic_time(1) + erlang:time_offset(1), + ?line B = erlang:unique_integer([positive]), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B)), + ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0 index f79e3ff634..16cecf2dba 100644 --- a/erts/emulator/valgrind/suppress.patched.3.6.0 +++ b/erts/emulator/valgrind/suppress.patched.3.6.0 @@ -362,3 +362,15 @@ fun:async_main ... } +{ +Deliberate invalid read by test case bif_SUITE:erlang_halt +Memcheck:Addr4 +... +fun:erts_print_scheduler_info +... +fun:erl_exit +fun:broken_halt_test +fun:erts_debug_set_internal_state_2 +fun:process_main +} + diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard index b3c77119fb..a1f3f82364 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -330,3 +330,15 @@ fun:async_main ... } +{ +Deliberate invalid read by test case bif_SUITE:erlang_halt +Memcheck:Addr4 +... +fun:erts_print_scheduler_info +... +fun:erl_exit +fun:broken_halt_test +fun:erts_debug_set_internal_state_2 +fun:process_main +} + 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/erlexec.c b/erts/etc/common/erlexec.c index 5ebde8ca3c..23226909a7 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -143,6 +143,7 @@ static char *pluss_val_switches[] = { static char *plush_val_switches[] = { "ms", "mbs", + "pds", "", NULL }; @@ -807,6 +808,7 @@ int main(int argc, char **argv) case 'a': case 'A': case 'b': + case 'C': case 'e': case 'i': case 'n': @@ -880,6 +882,19 @@ int main(int argc, char **argv) } add_Eargs(argv[i]); break; + case 'c': + argv[i][0] = '-'; + if (argv[i][2] == '\0' && i+1 < argc) { + if (sys_strcmp(argv[i+1], "true") == 0 + || sys_strcmp(argv[i+1], "false") == 0) { + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + break; + } + } + add_Eargs(argv[i]); + break; case 'M': { int x; for (x = 0; plusM_au_allocs[x]; x++) @@ -1149,8 +1164,8 @@ usage_aux(void) #endif "] " "[-make] [-man [manopts] MANPAGE] [-x] [-emu_args] " - "[-args_file FILENAME] [+A THREADS] [+a SIZE] [+B[c|d|i]] [+c] " - "[+h HEAP_SIZE_OPTION] [+K BOOLEAN] " + "[-args_file FILENAME] [+A THREADS] [+a SIZE] [+B[c|d|i]] [+c [BOOLEAN]] " + "[+C MODE] [+h HEAP_SIZE_OPTION] [+K BOOLEAN] " "[+l] [+M<SUBSWITCH> <ARGUMENT>] [+P MAX_PROCS] [+Q MAX_PORTS] " "[+R COMPAT_REL] " "[+r] [+rg READER_GROUPS_LIMIT] [+s SCHEDULER_OPTION] " diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index 2830641802..0d1dcacf2c 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -109,7 +109,7 @@ # include <sys/time.h> # include <unistd.h> # include <signal.h> -# if defined(CORRECT_USING_TIMES) +# if defined(OS_MONOTONIC_TIME_USING_TIMES) # include <sys/times.h> # include <limits.h> # endif @@ -117,11 +117,12 @@ #define HEART_COMMAND_ENV "HEART_COMMAND" #define ERL_CRASH_DUMP_SECONDS_ENV "ERL_CRASH_DUMP_SECONDS" +#define HEART_KILL_SIGNAL "HEART_KILL_SIGNAL" -#define MSG_HDR_SIZE 2 -#define MSG_HDR_PLUS_OP_SIZE 3 -#define MSG_BODY_SIZE 2048 -#define MSG_TOTAL_SIZE 2050 +#define MSG_HDR_SIZE (2) +#define MSG_HDR_PLUS_OP_SIZE (3) +#define MSG_BODY_SIZE (2048) +#define MSG_TOTAL_SIZE (2050) unsigned char cmd[MSG_BODY_SIZE]; @@ -555,14 +556,22 @@ kill_old_erlang(void){ static void kill_old_erlang(void){ pid_t pid; - int i; - int res; + int i, res; + int sig = SIGKILL; + char *sigenv = NULL; + + sigenv = get_env(HEART_KILL_SIGNAL); + if (sigenv && strcmp(sigenv, "SIGABRT") == 0) { + print_error("kill signal SIGABRT requested"); + sig = SIGABRT; + } + if(heart_beat_kill_pid != 0){ pid = (pid_t) heart_beat_kill_pid; - res = kill(pid,SIGKILL); + res = kill(pid,sig); for(i=0; i < 5 && res == 0; ++i){ sleep(1); - res = kill(pid,SIGKILL); + res = kill(pid,sig); } if(errno != ESRCH){ print_error("Unable to kill old process, " @@ -1084,9 +1093,9 @@ time_t timestamp(time_t *res) return r; } -#elif defined(HAVE_GETHRTIME) || defined(GETHRTIME_WITH_CLOCK_GETTIME) +#elif defined(OS_MONOTONIC_TIME_USING_GETHRTIME) || defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) -#if defined(GETHRTIME_WITH_CLOCK_GETTIME) +#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) typedef long long SysHrTime; SysHrTime sys_gethrtime(void); @@ -1095,7 +1104,7 @@ SysHrTime sys_gethrtime(void) { struct timespec ts; long long result; - if (clock_gettime(CLOCK_MONOTONIC,&ts) != 0) { + if (clock_gettime(MONOTONIC_CLOCK_ID,&ts) != 0) { print_error("Fatal, could not get clock_monotonic value, terminating! " "errno = %d\n", errno); exit(1); @@ -1122,7 +1131,7 @@ time_t timestamp(time_t *res) return r; } -#elif defined(CORRECT_USING_TIMES) +#elif defined(OS_MONOTONIC_TIME_USING_TIMES) # ifdef NO_SYSCONF # include <sys/param.h> 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/etc/unix/cerl.src b/erts/etc/unix/cerl.src index aa51eabfc5..59cf29d381 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -381,7 +381,9 @@ elif [ "x$GDB" = "xegdb" ]; then # Set annotation level for gdb in emacs 22 and higher. Seems to # be working with level 1 for emacs 22 and level 3 for emacs 23... emacs_major=`$EMACS --version | head -1 | sed 's,^[^0-9]*\([0-9]*\).*,\1,g'` - if [ '!' -z "$emacs_major" -a $emacs_major -gt 22 ]; then + if [ '!' -z "$emacs_major" -a $emacs_major -gt 23 ]; then + GDBARGS="-i=mi " + elif [ '!' -z "$emacs_major" -a $emacs_major -gt 22 ]; then GDBARGS="--annotate=3 " elif [ '!' -z "$emacs_major" -a $emacs_major -gt 21 ]; then GDBARGS="--annotate=1 " diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index c117a62a21..3ee092418e 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -146,14 +146,10 @@ define etp-1 etp-immediate-1 ($arg0) else # (($arg0) & 0x3) == 0 - if (($arg0) == 0x0) + if (($arg0) == etp_the_non_value) printf "<the non-value>" else - if (($arg0) == 0x4) - printf "<the non-value debug>" - else - etp-cp-1 ($arg0) - end + etp-cp-1 ($arg0) end end end @@ -355,7 +351,32 @@ define etp-boxed-1 etp-array-1 ((Eterm*)(($arg0)&~0x3)) ($arg1) ($arg1) \ 1 ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) '}' else - etp-boxed-immediate-1 ($arg0) + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3c) == 0x3c + # A map + if (((Eterm*)(($arg0) & ~0x3))[0] & 0xc0) == 0x0 + # Flat map + printf "#{Keys:" + etp-1 ((flatmap_t*)(($arg0)&~0x3))->keys (($arg1)+1) + printf " Values:{" + etp-array-1 ((Eterm*)(($arg0)&~0x3)+3) ($arg1) ($arg1) \ + 0 ((flatmap_t*)(($arg0)&~0x3))->size '}' + printf "}" + else + # Hashmap + printf "#<%x>{", (((((Eterm*)(($arg0)&~0x3))[0])>>(6+2+8))&0xffff) + if (((Eterm*)(($arg0) & ~0x3))[0] & 0xc0) >= 0x80 + # head bitmap/array + etp-bitmap-array-1 ((Eterm*)(($arg0)&~0x3)+2) ($arg1) ($arg1) \ + 0 (((((Eterm*)(($arg0)&~0x3))[0])>>(6+2+8))&0xffff) '}' + else + # node bitmap + etp-bitmap-array-1 ((Eterm*)(($arg0)&~0x3)+1) ($arg1) ($arg1) \ + 0 (((((Eterm*)(($arg0)&~0x3))[0])>>(6+2+8))&0xffff) '}' + end + end + else + etp-boxed-immediate-1 ($arg0) + end end end end @@ -478,6 +499,36 @@ define etp-array-1 end end +define etp-bitmap-array-1 +# Args: Eterm* p, int depth, int width, int pos, int bitmap, int end_char +# +# Reentrant +# +# Same as etp-array-1 with size = bitcount(bitmap) +# + if ($arg4) & 1 != 0 + if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth) + etp-1 (($arg0)[($arg3)]) (($arg1)+1) + if (($arg4) & (($arg4)-1)) != 0 + printf "," + end + etp-bitmap-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) (($arg4)>>1) ($arg5) + else + printf "...%c", ($arg5) + end + else + if ($arg4) == 0 + printf "%c", ($arg5) + else + etp-bitmap-array-1 $arg0 $arg1 $arg2 $arg3 (($arg4)>>1) $arg5 + + # WARNING: One might be tempted to optimize the bitcounting here + # by passing the bitmap argument as ($arg4 & ($arg4 - 1)). This is a very + # bad idea as arguments are passed as string substitution. + # The size of $arg4 would thus grow exponentially for each recursion. + end + end +end #define etpa-1 diff --git a/erts/example/Makefile b/erts/example/Makefile index 6e1a88b4da..b637bee033 100644 --- a/erts/example/Makefile +++ b/erts/example/Makefile @@ -30,7 +30,7 @@ CFLAGS += $(OUR_C_FLAGS) CXXFLAGS += $(OUR_C_FLAGS) TARGETS = pg_sync.beam pg_async.beam pg_sync.so pg_async.so \ -next_perm.so next_perm.beam +next_perm.so next_perm.beam time_compat.beam all: $(TARGETS) diff --git a/erts/example/time_compat.erl b/erts/example/time_compat.erl new file mode 100644 index 0000000000..90b7fbcc80 --- /dev/null +++ b/erts/example/time_compat.erl @@ -0,0 +1,303 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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 +%% 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% +%% + +%% +%% If your code need to be able to execute on ERTS versions both +%% earlier and later than 7.0, the best approach is to use the new +%% time API introduced in ERTS 7.0 and implement a fallback +%% solution using the old primitives to be used on old ERTS +%% versions. This way your code can automatically take advantage +%% of the improvements in the API when available. This is an +%% example of how to implement such an API, but it can be used +%% as is if you want to. Just add this module to your project, +%% and call the API via this module instead of calling the +%% BIFs directly. +%% + +-module(time_compat). + +%% We don't want warnings about the use of erlang:now/0 in +%% this module. +-compile(nowarn_deprecated_function). +%% +%% We don't use +%% -compile({nowarn_deprecated_function, [{erlang, now, 0}]}). +%% since this will produce warnings when compiled on systems +%% where it has not yet been deprecated. +%% + +-export([monotonic_time/0, + monotonic_time/1, + erlang_system_time/0, + erlang_system_time/1, + os_system_time/0, + os_system_time/1, + time_offset/0, + time_offset/1, + convert_time_unit/3, + timestamp/0, + unique_integer/0, + unique_integer/1, + monitor/2, + system_info/1, + system_flag/2]). + +monotonic_time() -> + try + erlang:monotonic_time() + catch + error:undef -> + %% Use Erlang system time as monotonic time + erlang_system_time_fallback() + end. + +monotonic_time(Unit) -> + try + erlang:monotonic_time(Unit) + catch + error:badarg -> + erlang:error(badarg, [Unit]); + error:undef -> + %% Use Erlang system time as monotonic time + STime = erlang_system_time_fallback(), + try + convert_time_unit_fallback(STime, native, Unit) + catch + error:bad_time_unit -> erlang:error(badarg, [Unit]) + end + end. + +erlang_system_time() -> + try + erlang:system_time() + catch + error:undef -> + erlang_system_time_fallback() + end. + +erlang_system_time(Unit) -> + try + erlang:system_time(Unit) + catch + error:badarg -> + erlang:error(badarg, [Unit]); + error:undef -> + STime = erlang_system_time_fallback(), + try + convert_time_unit_fallback(STime, native, Unit) + catch + error:bad_time_unit -> erlang:error(badarg, [Unit]) + end + end. + +os_system_time() -> + try + os:system_time() + catch + error:undef -> + os_system_time_fallback() + end. + +os_system_time(Unit) -> + try + os:system_time(Unit) + catch + error:badarg -> + erlang:error(badarg, [Unit]); + error:undef -> + STime = os_system_time_fallback(), + try + convert_time_unit_fallback(STime, native, Unit) + catch + error:bad_time_unit -> erlang:error(badarg, [Unit]) + end + end. + +time_offset() -> + try + erlang:time_offset() + catch + error:undef -> + %% Erlang system time and Erlang monotonic + %% time are always aligned + 0 + end. + +time_offset(Unit) -> + try + erlang:time_offset(Unit) + catch + error:badarg -> + erlang:error(badarg, [Unit]); + error:undef -> + try + _ = integer_time_unit(Unit) + catch + error:bad_time_unit -> erlang:error(badarg, [Unit]) + end, + %% Erlang system time and Erlang monotonic + %% time are always aligned + 0 + end. + +convert_time_unit(Time, FromUnit, ToUnit) -> + try + erlang:convert_time_unit(Time, FromUnit, ToUnit) + catch + error:undef -> + try + convert_time_unit_fallback(Time, FromUnit, ToUnit) + catch + _:_ -> + erlang:error(badarg, [Time, FromUnit, ToUnit]) + end; + error:Error -> + erlang:error(Error, [Time, FromUnit, ToUnit]) + end. + +timestamp() -> + try + erlang:timestamp() + catch + error:undef -> + erlang:now() + end. + +unique_integer() -> + try + erlang:unique_integer() + catch + error:undef -> + {MS, S, US} = erlang:now(), + (MS*1000000+S)*1000000+US + end. + +unique_integer(Modifiers) -> + try + erlang:unique_integer(Modifiers) + catch + error:badarg -> + erlang:error(badarg, [Modifiers]); + error:undef -> + case is_valid_modifier_list(Modifiers) of + true -> + %% now() converted to an integer + %% fullfill the requirements of + %% all modifiers: unique, positive, + %% and monotonic... + {MS, S, US} = erlang:now(), + (MS*1000000+S)*1000000+US; + false -> + erlang:error(badarg, [Modifiers]) + end + end. + +monitor(Type, Item) -> + try + erlang:monitor(Type, Item) + catch + error:Error -> + case {Error, Type, Item} of + {badarg, time_offset, clock_service} -> + %% Time offset is final and will never change. + %% Return a dummy reference, there will never + %% be any need for 'CHANGE' messages... + make_ref(); + _ -> + erlang:error(Error, [Type, Item]) + end + end. + +system_info(Item) -> + try + erlang:system_info(Item) + catch + error:badarg -> + case Item of + time_correction -> + case erlang:system_info(tolerant_timeofday) of + enabled -> true; + disabled -> false + end; + time_warp_mode -> + no_time_warp; + time_offset -> + final; + NotSupArg when NotSupArg == os_monotonic_time_source; + NotSupArg == os_system_time_source; + NotSupArg == start_time -> + %% Cannot emulate this... + erlang:error(notsup, [NotSupArg]); + _ -> + erlang:error(badarg, [Item]) + end; + error:Error -> + erlang:error(Error, [Item]) + end. + +system_flag(Flag, Value) -> + try + erlang:system_flag(Flag, Value) + catch + error:Error -> + case {Error, Flag, Value} of + {badarg, time_offset, finalize} -> + %% Time offset is final + final; + _ -> + erlang:error(Error, [Flag, Value]) + end + end. + +%% +%% Internal functions +%% + +integer_time_unit(native) -> 1000*1000; +integer_time_unit(nano_seconds) -> 1000*1000*1000; +integer_time_unit(micro_seconds) -> 1000*1000; +integer_time_unit(milli_seconds) -> 1000; +integer_time_unit(seconds) -> 1; +integer_time_unit(I) when is_integer(I), I > 0 -> I; +integer_time_unit(BadRes) -> erlang:error(bad_time_unit, [BadRes]). + +erlang_system_time_fallback() -> + {MS, S, US} = erlang:now(), + (MS*1000000+S)*1000000+US. + +os_system_time_fallback() -> + {MS, S, US} = os:timestamp(), + (MS*1000000+S)*1000000+US. + +convert_time_unit_fallback(Time, FromUnit, ToUnit) -> + FU = integer_time_unit(FromUnit), + TU = integer_time_unit(ToUnit), + case Time < 0 of + true -> TU*Time - (FU - 1); + false -> TU*Time + end div FU. + +is_valid_modifier_list([positive|Ms]) -> + is_valid_modifier_list(Ms); +is_valid_modifier_list([monotonic|Ms]) -> + is_valid_modifier_list(Ms); +is_valid_modifier_list([]) -> + true; +is_valid_modifier_list(_) -> + false. diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h index c9b1db5b46..65195145af 100644 --- a/erts/include/internal/ethr_internal.h +++ b/erts/include/internal/ethr_internal.h @@ -57,6 +57,33 @@ ETHR_PROTO_NORETURN__ ethr_abort__(void); int ethr_win_get_errno__(void); #endif +#ifdef ETHR_INCLUDE_MONOTONIC_CLOCK__ +#undef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME +#if defined(ETHR_HAVE_CLOCK_GETTIME_MONOTONIC) \ + || defined(ETHR_HAVE_MACH_CLOCK_GET_TIME) \ + || defined(ETHR_HAVE_GETHRTIME) +#ifdef ETHR_TIME_WITH_SYS_TIME +# include <time.h> +# include <sys/time.h> +#else +# ifdef ETHR_HAVE_SYS_TIME_H +# include <sys/time.h> +# else +# include <time.h> +# endif +#endif +#ifdef ETHR_HAVE_MACH_CLOCK_GET_TIME +#include <mach/clock.h> +#include <mach/mach.h> +#endif +#define ETHR_HAVE_ETHR_GET_MONOTONIC_TIME +ethr_sint64_t ethr_get_monotonic_time(void); +int ethr_get_monotonic_time_is_broken(void); +#endif +#endif /* ETHR_INCLUDE_MONOTONIC_CLOCK__ */ + +void ethr_init_event__(void); + /* implemented in lib_src/common/ethread_aux.c */ int ethr_init_common__(ethr_init_data *id); int ethr_late_init_common__(ethr_late_init_data *lid); diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 0d9a4a4305..e598017ada 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -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 @@ -362,6 +362,9 @@ extern ethr_runtime_t ethr_runtime__; # include "sparc64/ethread.h" # endif # endif +# if ETHR_HAVE_GCC___ATOMIC_BUILTINS +# include "gcc/ethread.h" +# endif # include "libatomic_ops/ethread.h" # include "gcc/ethread.h" # endif diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in index b36322490a..a9727568a2 100644 --- a/erts/include/internal/ethread_header_config.h.in +++ b/erts/include/internal/ethread_header_config.h.in @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. 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 @@ -84,32 +84,62 @@ /* Define if run in Sparc RMO, PSO, or TSO mode */ #undef ETHR_SPARC_RMO -/* Define if you have __sync_add_and_fetch() for 32-bit integers */ -#undef ETHR_HAVE___SYNC_ADD_AND_FETCH32 +/* Define as a boolean indicating whether you have a gcc compatible compiler + capable of generating the ARM DMB instruction, and are compiling for an ARM + processor with ARM DMB instruction support, or not */ +#undef ETHR_HAVE_GCC_ASM_ARM_DMB_INSTRUCTION -/* Define if you have __sync_add_and_fetch() for 64-bit integers */ -#undef ETHR_HAVE___SYNC_ADD_AND_FETCH64 +/* Define as a bitmask corresponding to the word sizes that + __sync_synchronize() can handle on your system */ +#undef ETHR_HAVE___sync_synchronize -/* Define if you have __sync_fetch_and_and() for 32-bit integers */ -#undef ETHR_HAVE___SYNC_FETCH_AND_AND32 +/* Define as a bitmask corresponding to the word sizes that + __sync_add_and_fetch() can handle on your system */ +#undef ETHR_HAVE___sync_add_and_fetch -/* Define if you have __sync_fetch_and_and() for 64-bit integers */ -#undef ETHR_HAVE___SYNC_FETCH_AND_AND64 +/* Define as a bitmask corresponding to the word sizes that + __sync_fetch_and_and() can handle on your system */ +#undef ETHR_HAVE___sync_fetch_and_and -/* Define if you have __sync_fetch_and_or() for 32-bit integers */ -#undef ETHR_HAVE___SYNC_FETCH_AND_OR32 +/* Define as a bitmask corresponding to the word sizes that + __sync_fetch_and_or() can handle on your system */ +#undef ETHR_HAVE___sync_fetch_and_or -/* Define if you have __sync_fetch_and_or() for 64-bit integers */ -#undef ETHR_HAVE___SYNC_FETCH_AND_OR64 +/* Define as a bitmask corresponding to the word sizes that + __sync_val_compare_and_swap() can handle on your system */ +#undef ETHR_HAVE___sync_val_compare_and_swap -/* Define if you have __sync_val_compare_and_swap() for 32-bit integers */ -#undef ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP32 +/* Define as a boolean indicating whether you have a gcc __atomic builtins or + not */ +#undef ETHR_HAVE_GCC___ATOMIC_BUILTINS -/* Define if you have __sync_val_compare_and_swap() for 64-bit integers */ -#undef ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64 +/* Define as a boolean indicating whether you trust gcc's __atomic_* builtins + memory barrier implementations, or not */ +#undef ETHR_TRUST_GCC_ATOMIC_BUILTINS_MEMORY_BARRIERS -/* Define if you have __sync_val_compare_and_swap() for 128-bit integers */ -#undef ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP128 +/* Define as a bitmask corresponding to the word sizes that __atomic_store_n() + can handle on your system */ +#undef ETHR_HAVE___atomic_store_n + +/* Define as a bitmask corresponding to the word sizes that __atomic_load_n() + can handle on your system */ +#undef ETHR_HAVE___atomic_load_n + +/* Define as a bitmask corresponding to the word sizes that + __atomic_add_fetch() can handle on your system */ +#undef ETHR_HAVE___atomic_add_fetch + +/* Define as a bitmask corresponding to the word sizes that + __atomic_fetch_and() can handle on your system */ +#undef ETHR_HAVE___atomic_fetch_and + +/* Define as a bitmask corresponding to the word sizes that + __atomic_fetch_or() can handle on your system */ +#undef ETHR_HAVE___atomic_fetch_or + +/* Define as a bitmask corresponding to the word sizes that + __atomic_compare_exchange_n() can handle on your system */ +#undef ETHR_HAVE___atomic_compare_exchange_n /* Define if you prefer gcc native ethread implementations */ #undef ETHR_PREFER_GCC_NATIVE_IMPLS @@ -237,3 +267,18 @@ /* Assumed cache-line size (in bytes) */ #undef ASSUMED_CACHE_LINE_SIZE + +/* Define if you have a clock_gettime() with a monotonic clock */ +#undef ETHR_HAVE_CLOCK_GETTIME_MONOTONIC + +/* Define if you have a monotonic gethrtime() */ +#undef ETHR_HAVE_GETHRTIME + +/* Define if you have a mach clock_get_time() with a monotonic clock */ +#undef ETHR_HAVE_MACH_CLOCK_GET_TIME + +/* Define to the monotonic clock id to use */ +#undef ETHR_MONOTONIC_CLOCK_ID + +/* Define if pthread_cond_timedwait() can be used with a monotonic clock */ +#undef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC diff --git a/erts/include/internal/ethread_inline.h b/erts/include/internal/ethread_inline.h index ffb756c84f..c09a67619a 100644 --- a/erts/include/internal/ethread_inline.h +++ b/erts/include/internal/ethread_inline.h @@ -20,6 +20,29 @@ #ifndef ETHREAD_INLINE_H__ #define ETHREAD_INLINE_H__ +#define ETHR_GCC_COMPILER_FALSE 0 /* Not a gcc compatible compiler */ +#define ETHR_GCC_COMPILER_TRUE 1 /* The GNU gcc compiler */ +/* Negative integers for gcc compatible compilers */ +#define ETHR_GCC_COMPILER_CLANG -1 /* The Clang gcc compatible compiler */ +#define ETHR_GCC_COMPILER_ICC -2 /* The Intel gcc compatible compiler */ +/* Line them up... */ + +/* + * Unfortunately there is no easy and certain way of + * detecting a true gcc compiler, since the compatible + * ones all define the same defines as the true gnu-gcc... + */ +#if !defined(__GNUC__) && !defined(__GNUG__) +# define ETHR_GCC_COMPILER ETHR_GCC_COMPILER_FALSE +#elif defined(__clang__) +# define ETHR_GCC_COMPILER ETHR_GCC_COMPILER_CLANG +#elif defined(__ICC) || defined(__INTEL_COMPILER) +# define ETHR_GCC_COMPILER ETHR_GCC_COMPILER_ICC +#else +/* Seems to be the true gnu-gcc... */ +# define ETHR_GCC_COMPILER ETHR_GCC_COMPILER_TRUE +#endif + #if !defined(__GNUC__) # define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0 #elif !defined(__GNUC_MINOR__) diff --git a/erts/include/internal/gcc/ethr_atomic.h b/erts/include/internal/gcc/ethr_atomic.h index f598f8537b..62eed78f76 100644 --- a/erts/include/internal/gcc/ethr_atomic.h +++ b/erts/include/internal/gcc/ethr_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. 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 @@ -18,78 +18,81 @@ */ /* - * Description: Native atomics ethread support using gcc's builtins + * Description: Native atomics ethread support using gcc's __atomic + * and __sync builtins * Author: Rickard Green + * + * Note: The C11 memory model implemented by gcc's __atomic + * builtins does not match the ethread API very well. + * + * Due to this we cannot use the __ATOMIC_SEQ_CST + * memory model. For more information see the comment + * in the begining of ethr_membar.h in this directory. */ #undef ETHR_INCLUDE_ATOMIC_IMPL__ -#if !defined(ETHR_GCC_ATOMIC32_H__) && defined(ETHR_ATOMIC_WANT_32BIT_IMPL__) -#define ETHR_GCC_ATOMIC32_H__ -#if defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP32) -# define ETHR_INCLUDE_ATOMIC_IMPL__ 4 -#endif +#if !defined(ETHR_GCC_ATOMIC_ATOMIC32_H__) \ + && defined(ETHR_ATOMIC_WANT_32BIT_IMPL__) \ + && ((ETHR_HAVE___sync_val_compare_and_swap & 4) \ + || (ETHR_HAVE___atomic_compare_exchange_n & 4)) + +#define ETHR_GCC_ATOMIC_ATOMIC32_H__ +#define ETHR_INCLUDE_ATOMIC_IMPL__ 4 #undef ETHR_ATOMIC_WANT_32BIT_IMPL__ -#elif !defined(ETHR_GCC_ATOMIC64_H__) && defined(ETHR_ATOMIC_WANT_64BIT_IMPL__) -#define ETHR_GCC_ATOMIC64_H__ -#if defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64) -# define ETHR_INCLUDE_ATOMIC_IMPL__ 8 -#endif -#undef ETHR_ATOMIC_WANT_64BIT_IMPL__ -#endif -#ifdef ETHR_INCLUDE_ATOMIC_IMPL__ +#elif !defined(ETHR_GCC_ATOMIC64_H__) \ + && defined(ETHR_ATOMIC_WANT_64BIT_IMPL__) \ + && ((ETHR_HAVE___sync_val_compare_and_swap & 8) \ + || (ETHR_HAVE___atomic_compare_exchange_n & 8)) -#ifndef ETHR_GCC_ATOMIC_COMMON__ -#define ETHR_GCC_ATOMIC_COMMON__ +#define ETHR_GCC_ATOMIC64_H__ +#define ETHR_INCLUDE_ATOMIC_IMPL__ 8 +#undef ETHR_ATOMIC_WANT_64BIT_IMPL__ -#define ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ 0 -#if defined(__i386__) || defined(__x86_64__) || defined(__sparc__) \ - || defined(__powerpc__) || defined(__ppc__) || defined(__mips__) -# undef ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ -# define ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ 1 #endif -#endif /* ETHR_GCC_ATOMIC_COMMON__ */ +#ifdef ETHR_INCLUDE_ATOMIC_IMPL__ #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 #define ETHR_HAVE_NATIVE_ATOMIC32 1 -#define ETHR_NATIVE_ATOMIC32_IMPL "gcc" #define ETHR_NATMC_FUNC__(X) ethr_native_atomic32_ ## X #define ETHR_ATMC_T__ ethr_native_atomic32_t #define ETHR_AINT_T__ ethr_sint32_t -#if defined(ETHR_HAVE___SYNC_ADD_AND_FETCH32) -# define ETHR_HAVE___SYNC_ADD_AND_FETCH -#endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_AND32) -# define ETHR_HAVE___SYNC_FETCH_AND_AND -#endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_OR32) -# define ETHR_HAVE___SYNC_FETCH_AND_OR +#if ((ETHR_HAVE___sync_val_compare_and_swap & 4) \ + && (ETHR_HAVE___atomic_compare_exchange_n & 4)) +# define ETHR_NATIVE_ATOMIC32_IMPL "gcc_atomic_and_sync_builtins" +#elif (ETHR_HAVE___atomic_compare_exchange_n & 4) +# define ETHR_NATIVE_ATOMIC32_IMPL "gcc_atomic_builtins" +#elif (ETHR_HAVE___sync_val_compare_and_swap & 4) +# define ETHR_NATIVE_ATOMIC32_IMPL "gcc_sync_builtins" +#else +# error "!?" #endif #elif ETHR_INCLUDE_ATOMIC_IMPL__ == 8 #define ETHR_HAVE_NATIVE_ATOMIC64 1 -#define ETHR_NATIVE_ATOMIC64_IMPL "gcc" #define ETHR_NATMC_FUNC__(X) ethr_native_atomic64_ ## X #define ETHR_ATMC_T__ ethr_native_atomic64_t #define ETHR_AINT_T__ ethr_sint64_t -#if defined(ETHR_HAVE___SYNC_ADD_AND_FETCH64) -# define ETHR_HAVE___SYNC_ADD_AND_FETCH -#endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_AND64) -# define ETHR_HAVE___SYNC_FETCH_AND_AND -#endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_OR64) -# define ETHR_HAVE___SYNC_FETCH_AND_OR +#if ((ETHR_HAVE___sync_val_compare_and_swap & 8) \ + && (ETHR_HAVE___atomic_compare_exchange_n & 8)) +# define ETHR_NATIVE_ATOMIC64_IMPL "gcc_atomic_and_sync_builtins" +#elif (ETHR_HAVE___atomic_compare_exchange_n & 8) +# define ETHR_NATIVE_ATOMIC64_IMPL "gcc_atomic_builtins" +#elif (ETHR_HAVE___sync_val_compare_and_swap & 8) +# define ETHR_NATIVE_ATOMIC64_IMPL "gcc_sync_builtins" +#else +# error "!?" #endif #else #error "Unsupported integer size" #endif +#undef ETHR_NATIVE_ATOMIC_IMPL__ + typedef struct { - volatile ETHR_AINT_T__ counter; + volatile ETHR_AINT_T__ value; } ETHR_ATMC_T__; - #if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_ATOMIC_IMPL__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 @@ -98,13 +101,19 @@ typedef struct { # define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_ADDR 1 #endif + static ETHR_INLINE ETHR_AINT_T__ * ETHR_NATMC_FUNC__(addr)(ETHR_ATMC_T__ *var) { - return (ETHR_AINT_T__ *) &var->counter; + return (ETHR_AINT_T__ *) &var->value; } -#if ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ +/* + * set() + */ +#if (ETHR_HAVE___atomic_store_n & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_SET 1 @@ -115,12 +124,109 @@ ETHR_NATMC_FUNC__(addr)(ETHR_ATMC_T__ *var) static ETHR_INLINE void ETHR_NATMC_FUNC__(set)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ value) { - var->counter = value; + __atomic_store_n(&var->value, value, __ATOMIC_RELAXED); } -#endif /* ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ */ +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ -#if ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ +#if (ETHR_GCC_RELB_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_SET_RELB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_SET_RELB 1 +#endif + +static ETHR_INLINE void +ETHR_NATMC_FUNC__(set_relb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ value) +{ + __atomic_store_n(&var->value, value, __ATOMIC_RELEASE); +} + +#endif /* ETHR_GCC_RELB_VERSIONS__ */ + +#elif (ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_SET 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_SET 1 +#endif + +static ETHR_INLINE void +ETHR_NATMC_FUNC__(set)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ value) +{ + var->value = value; +} + +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ + +#if (ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELB_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_SET_RELB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_SET_RELB 1 +#endif + +static ETHR_INLINE void +ETHR_NATMC_FUNC__(set_relb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ value) +{ + var->value = value; +} + +#endif /* ETHR_GCC_RELB_VERSIONS__ */ + +#endif /* ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ */ + +#endif /* ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ */ + +/* + * read() + */ + +#if (ETHR_HAVE___atomic_load_n & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_READ 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_READ 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(read)(ETHR_ATMC_T__ *var) +{ + return __atomic_load_n(&var->value, __ATOMIC_RELAXED); +} + +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ + +#if ((ETHR_GCC_ACQB_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) \ + & ~ETHR___atomic_load_ACQUIRE_barrier_bug) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_READ_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_READ_ACQB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(read_acqb)(ETHR_ATMC_T__ *var) +{ + return __atomic_load_n(&var->value, __ATOMIC_ACQUIRE); +} + +#endif /* ETHR_GCC_ACQB_VERSIONS__ */ + +#elif (ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_READ 1 @@ -131,12 +237,90 @@ ETHR_NATMC_FUNC__(set)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ value) static ETHR_INLINE ETHR_AINT_T__ ETHR_NATMC_FUNC__(read)(ETHR_ATMC_T__ *var) { - return var->counter; + return var->value; +} + +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ + +#if (ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_ACQB_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_READ_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_READ_ACQB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(read_acqb)(ETHR_ATMC_T__ *var) +{ + return var->value; +} + +#endif /* ETHR_GCC_ACQB_VERSIONS__ */ + +#endif /* ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ */ + +#endif /* ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ */ + +/* + * add_return() + */ +#if (ETHR_HAVE___atomic_add_fetch & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_ADD_RETURN 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_ADD_RETURN 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(add_return)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ incr) +{ + return __atomic_add_fetch(&var->value, incr, __ATOMIC_RELAXED); } -#endif /* ETHR_READ_AND_SET_WITHOUT_SYNC_OP__ */ +#endif /* ETHR_GCC_RELAXED_MOD_VERSIONS__ */ -#if defined(ETHR_HAVE___SYNC_ADD_AND_FETCH) +#if (ETHR_GCC_ACQB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_ADD_RETURN_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_ADD_RETURN_ACQB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(add_return_acqb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ incr) +{ + return __atomic_add_fetch(&var->value, incr, __ATOMIC_ACQUIRE); +} + +#endif /* ETHR_GCC_ACQB_MOD_VERSIONS__ */ + +#if (ETHR_GCC_RELB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_ADD_RETURN_RELB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_ADD_RETURN_RELB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(add_return_relb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ incr) +{ + return __atomic_add_fetch(&var->value, incr, __ATOMIC_RELEASE); +} + +#endif /* ETHR_GCC_RELB_MOD_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_add_fetch */ + +#if ((ETHR_HAVE___sync_add_and_fetch & ETHR_INCLUDE_ATOMIC_IMPL__) \ + & ETHR_GCC_MB_MOD_VERSIONS__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_ADD_RETURN_MB 1 @@ -147,12 +331,68 @@ ETHR_NATMC_FUNC__(read)(ETHR_ATMC_T__ *var) static ETHR_INLINE ETHR_AINT_T__ ETHR_NATMC_FUNC__(add_return_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ incr) { - return __sync_add_and_fetch(&var->counter, incr); + return __sync_add_and_fetch(&var->value, incr); +} + +#endif /* ETHR_HAVE___sync_add_and_fetch */ + +/* + * and_retold() + */ +#if (ETHR_HAVE___atomic_fetch_and & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_AND_RETOLD 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_AND_RETOLD 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(and_retold)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_and(&var->value, mask, __ATOMIC_RELAXED); +} + +#endif /* ETHR_GCC_RELAXED_MOD_VERSIONS__ */ + +#if (ETHR_GCC_ACQB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_AND_RETOLD_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_AND_RETOLD_ACQB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(and_retold_acqb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_and(&var->value, mask, __ATOMIC_ACQUIRE); } +#endif /* ETHR_GCC_ACQB_MOD_VERSIONS__ */ + +#if (ETHR_GCC_RELB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_AND_RETOLD_RELB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_AND_RETOLD_RELB 1 #endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_AND) +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(and_retold_relb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_and(&var->value, mask, __ATOMIC_RELEASE); +} + +#endif /* ETHR_GCC_RELB_MOD_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_fetch_and */ + +#if ((ETHR_HAVE___sync_fetch_and_and & ETHR_INCLUDE_ATOMIC_IMPL__) \ + & ETHR_GCC_MB_MOD_VERSIONS__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_AND_RETOLD_MB 1 @@ -163,12 +403,68 @@ ETHR_NATMC_FUNC__(add_return_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ incr) static ETHR_INLINE ETHR_AINT_T__ ETHR_NATMC_FUNC__(and_retold_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) { - return __sync_fetch_and_and(&var->counter, mask); + return __sync_fetch_and_and(&var->value, mask); +} + +#endif /* ETHR_HAVE___sync_fetch_and_and */ + +/* + * or_retold() + */ +#if (ETHR_HAVE___atomic_fetch_or & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_OR_RETOLD 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_OR_RETOLD 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(or_retold)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_or(&var->value, mask, __ATOMIC_RELAXED); +} + +#endif /* ETHR_GCC_RELAXED_MOD_VERSIONS__ */ + +#if (ETHR_GCC_ACQB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_OR_RETOLD_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_OR_RETOLD_ACQB 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(or_retold_acqb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_or(&var->value, mask, __ATOMIC_ACQUIRE); } +#endif /* ETHR_GCC_ACQB_MOD_VERSIONS__ */ + +#if (ETHR_GCC_RELB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_OR_RETOLD_RELB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_OR_RETOLD_RELB 1 #endif -#if defined(ETHR_HAVE___SYNC_FETCH_AND_OR) +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(or_retold_relb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) +{ + return __atomic_fetch_or(&var->value, mask, __ATOMIC_RELEASE); +} + +#endif /* ETHR_GCC_RELB_MOD_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_fetch_or */ + +#if ((ETHR_HAVE___sync_fetch_and_or & ETHR_INCLUDE_ATOMIC_IMPL__) \ + & ETHR_GCC_MB_MOD_VERSIONS__) #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_OR_RETOLD_MB 1 @@ -179,11 +475,73 @@ ETHR_NATMC_FUNC__(and_retold_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) static ETHR_INLINE ETHR_AINT_T__ ETHR_NATMC_FUNC__(or_retold_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ mask) { - return (ETHR_AINT_T__) __sync_fetch_and_or(&var->counter, mask); + return (ETHR_AINT_T__) __sync_fetch_and_or(&var->value, mask); +} + +#endif /* ETHR_HAVE___sync_fetch_and_or */ + +/* + * cmpxchg() + */ +#if (ETHR_HAVE___atomic_compare_exchange_n & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if (ETHR_GCC_RELAXED_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_CMPXCHG 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_CMPXCHG 1 +#endif + +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(cmpxchg)(ETHR_ATMC_T__ *var, + ETHR_AINT_T__ new, + ETHR_AINT_T__ exp) +{ + ETHR_AINT_T__ xchg = exp; + if (__atomic_compare_exchange_n(&var->value, + &xchg, + new, + 0, /* No spurious failures, please */ + __ATOMIC_RELAXED, + __ATOMIC_RELAXED)) + return exp; + return xchg; } +#endif /* ETHR_GCC_RELAXED_MOD_VERSIONS__ */ + +#if (ETHR_GCC_ACQB_MOD_VERSIONS__ & ETHR_INCLUDE_ATOMIC_IMPL__) + +#if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_CMPXCHG_ACQB 1 +#else +# define ETHR_HAVE_ETHR_NATIVE_ATOMIC64_CMPXCHG_ACQB 1 #endif +static ETHR_INLINE ETHR_AINT_T__ +ETHR_NATMC_FUNC__(cmpxchg_acqb)(ETHR_ATMC_T__ *var, + ETHR_AINT_T__ new, + ETHR_AINT_T__ exp) +{ + ETHR_AINT_T__ xchg = exp; + if (__atomic_compare_exchange_n(&var->value, + &xchg, + new, + 0, /* No spurious failures, please */ + __ATOMIC_ACQUIRE, + __ATOMIC_ACQUIRE)) + return exp; + return xchg; +} + +#endif /* ETHR_GCC_ACQB_MOD_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_compare_exchange_n */ + +#if ((ETHR_HAVE___sync_val_compare_and_swap & ETHR_INCLUDE_ATOMIC_IMPL__) \ + & ETHR_GCC_MB_MOD_VERSIONS__) + #if ETHR_INCLUDE_ATOMIC_IMPL__ == 4 # define ETHR_HAVE_ETHR_NATIVE_ATOMIC32_CMPXCHG_MB 1 #else @@ -195,17 +553,16 @@ ETHR_NATMC_FUNC__(cmpxchg_mb)(ETHR_ATMC_T__ *var, ETHR_AINT_T__ new, ETHR_AINT_T__ old) { - return __sync_val_compare_and_swap(&var->counter, old, new); + return __sync_val_compare_and_swap(&var->value, old, new); } +#endif /* ETHR_HAVE___sync_val_compare_and_swap */ + #endif /* ETHR_TRY_INLINE_FUNCS */ #undef ETHR_NATMC_FUNC__ #undef ETHR_ATMC_T__ #undef ETHR_AINT_T__ #undef ETHR_AINT_SUFFIX__ -#undef ETHR_HAVE___SYNC_ADD_AND_FETCH -#undef ETHR_HAVE___SYNC_FETCH_AND_AND -#undef ETHR_HAVE___SYNC_FETCH_AND_OR #endif diff --git a/erts/include/internal/gcc/ethr_dw_atomic.h b/erts/include/internal/gcc/ethr_dw_atomic.h index 6736f9c547..c2c8f85b7b 100644 --- a/erts/include/internal/gcc/ethr_dw_atomic.h +++ b/erts/include/internal/gcc/ethr_dw_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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,35 +18,39 @@ */ /* - * Description: Native double word atomics using gcc's builtins + * Description: Native double word atomics using gcc's __atomic + * and __sync builtins * Author: Rickard Green + * + * Note: The C11 memory model implemented by gcc's __atomic + * builtins does not match the ethread API very well. + * + * Due to this we cannot use the __ATOMIC_SEQ_CST + * memory model. For more information see the comment + * in the begining of ethr_membar.h in this directory. */ #undef ETHR_INCLUDE_DW_ATOMIC_IMPL__ -#ifndef ETHR_GCC_DW_ATOMIC_H__ -# define ETHR_GCC_DW_ATOMIC_H__ -# if ((ETHR_SIZEOF_PTR == 4 \ - && defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64)) \ - || (ETHR_SIZEOF_PTR == 8 \ - && defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP128) \ - && defined(ETHR_HAVE_INT128_T))) -# define ETHR_INCLUDE_DW_ATOMIC_IMPL__ -# endif +#if !defined(ETHR_GCC_ATOMIC_DW_ATOMIC_H__) \ + && ((ETHR_HAVE___sync_val_compare_and_swap & (2*ETHR_SIZEOF_PTR)) \ + || (ETHR_HAVE___atomic_compare_exchange_n & (2*ETHR_SIZEOF_PTR))) +# define ETHR_GCC_ATOMIC_DW_ATOMIC_H__ +# define ETHR_INCLUDE_DW_ATOMIC_IMPL__ #endif #ifdef ETHR_INCLUDE_DW_ATOMIC_IMPL__ # define ETHR_HAVE_NATIVE_SU_DW_ATOMIC -# define ETHR_NATIVE_DW_ATOMIC_IMPL "gcc" -# if defined(__i386__) || defined(__x86_64__) -/* - * If ETHR_RTCHK_USE_NATIVE_DW_ATOMIC_IMPL__ is defined, it will be used - * at runtime in order to determine if native or fallback implementation - * should be used. - */ -# define ETHR_RTCHK_USE_NATIVE_DW_ATOMIC_IMPL__ \ - ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ -# endif +#if ((ETHR_HAVE___sync_val_compare_and_swap & (2*ETHR_SIZEOF_PTR)) \ + && (ETHR_HAVE___atomic_compare_exchange_n & (2*ETHR_SIZEOF_PTR))) +# define ETHR_NATIVE_DW_ATOMIC_IMPL "gcc_atomic_and_sync_builtins" +#elif (ETHR_HAVE___atomic_compare_exchange_n & (2*ETHR_SIZEOF_PTR)) +# define ETHR_NATIVE_DW_ATOMIC_IMPL "gcc_atomic_builtins" +#elif (ETHR_HAVE___sync_val_compare_and_swap & (2*ETHR_SIZEOF_PTR)) +# define ETHR_NATIVE_DW_ATOMIC_IMPL "gcc_sync_builtins" +#else +# error "!?" +#endif # if ETHR_SIZEOF_PTR == 4 # define ETHR_DW_NATMC_ALIGN_MASK__ 0x7 @@ -89,15 +93,138 @@ typedef union { # define ETHR_DW_DBG_ALIGNED__(PTR) # endif -#define ETHR_HAVE_ETHR_NATIVE_DW_ATOMIC_ADDR + +#define ETHR_HAVE_ETHR_NATIVE_DW_ATOMIC_ADDR 1 + static ETHR_INLINE ethr_sint_t * ethr_native_dw_atomic_addr(ethr_native_dw_atomic_t *var) { return (ethr_sint_t *) ETHR_DW_NATMC_MEM__(var); } +#if (ETHR_HAVE___atomic_store_n & (2*ETHR_SIZEOF_PTR)) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_SET 1 + +static ETHR_INLINE void +ethr_native_su_dw_atomic_set(ethr_native_dw_atomic_t *var, + ETHR_NATIVE_SU_DW_SINT_T value) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_DW_DBG_ALIGNED__(p); + __atomic_store_n(p, value, __ATOMIC_RELAXED); +} + +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ + +#if (ETHR_GCC_RELB_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) -#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_CMPXCHG_MB +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_SET_RELB 1 + +static ETHR_INLINE void +ethr_native_su_dw_atomic_set_relb(ethr_native_dw_atomic_t *var, + ETHR_NATIVE_SU_DW_SINT_T value) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_DW_DBG_ALIGNED__(p); + __atomic_store_n(p, value, __ATOMIC_RELEASE); +} + +#endif /* ETHR_GCC_RELB_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_store_n */ + +#if (ETHR_HAVE___atomic_load_n & (2*ETHR_SIZEOF_PTR)) + +#if (ETHR_GCC_RELAXED_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_READ 1 + +static ETHR_INLINE ETHR_NATIVE_SU_DW_SINT_T +ethr_native_su_dw_atomic_read(ethr_native_dw_atomic_t *var) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_DW_DBG_ALIGNED__(p); + return __atomic_load_n(p, __ATOMIC_RELAXED); +} + +#endif /* ETHR_GCC_RELAXED_VERSIONS__ */ + +#if ((ETHR_GCC_ACQB_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) \ + & ~ETHR___atomic_load_ACQUIRE_barrier_bug) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_READ_ACQB 1 + +static ETHR_INLINE ETHR_NATIVE_SU_DW_SINT_T +ethr_native_su_dw_atomic_read_acqb(ethr_native_dw_atomic_t *var) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_DW_DBG_ALIGNED__(p); + return __atomic_load_n(p, __ATOMIC_ACQUIRE); +} + +#endif /* ETHR_GCC_ACQB_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_load_n */ + +#if (ETHR_HAVE___atomic_compare_exchange_n & (2*ETHR_SIZEOF_PTR)) + +#if (ETHR_GCC_RELAXED_MOD_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_CMPXCHG 1 + +static ETHR_INLINE ETHR_NATIVE_SU_DW_SINT_T +ethr_native_su_dw_atomic_cmpxchg(ethr_native_dw_atomic_t *var, + ETHR_NATIVE_SU_DW_SINT_T new, + ETHR_NATIVE_SU_DW_SINT_T exp) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_NATIVE_SU_DW_SINT_T xchg = exp; + ETHR_DW_DBG_ALIGNED__(p); + if (__atomic_compare_exchange_n(p, + &xchg, + new, + 0, + __ATOMIC_RELAXED, + __ATOMIC_RELAXED)) + return exp; + return xchg; +} + +#endif /* ETHR_GCC_RELAXED_MOD_VERSIONS__ */ + +#if (ETHR_GCC_ACQB_MOD_VERSIONS__ & (2*ETHR_SIZEOF_PTR)) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_CMPXCHG_ACQB 1 + +static ETHR_INLINE ETHR_NATIVE_SU_DW_SINT_T +ethr_native_su_dw_atomic_cmpxchg_acqb(ethr_native_dw_atomic_t *var, + ETHR_NATIVE_SU_DW_SINT_T new, + ETHR_NATIVE_SU_DW_SINT_T exp) +{ + ethr_native_dw_ptr_t p = (ethr_native_dw_ptr_t) ETHR_DW_NATMC_MEM__(var); + ETHR_NATIVE_SU_DW_SINT_T xchg = exp; + ETHR_DW_DBG_ALIGNED__(p); + if (__atomic_compare_exchange_n(p, + &xchg, + new, + 0, + __ATOMIC_ACQUIRE, + __ATOMIC_ACQUIRE)) + return exp; + return xchg; +} + +#endif /* ETHR_GCC_ACQB_MOD_VERSIONS__ */ + +#endif /* ETHR_HAVE___atomic_compare_exchange_n */ + +#if ((ETHR_HAVE___sync_val_compare_and_swap & (2*ETHR_SIZEOF_PTR)) \ + & ETHR_GCC_MB_MOD_VERSIONS__) + +#define ETHR_HAVE_ETHR_NATIVE_SU_DW_ATOMIC_CMPXCHG_MB 1 static ETHR_INLINE ETHR_NATIVE_SU_DW_SINT_T ethr_native_su_dw_atomic_cmpxchg_mb(ethr_native_dw_atomic_t *var, @@ -109,7 +236,8 @@ ethr_native_su_dw_atomic_cmpxchg_mb(ethr_native_dw_atomic_t *var, return __sync_val_compare_and_swap(p, old, new); } -#endif /* ETHR_TRY_INLINE_FUNCS */ +#endif /* ETHR_HAVE___sync_val_compare_and_swap */ -#endif /* ETHR_GCC_DW_ATOMIC_H__ */ +#endif /* ETHR_TRY_INLINE_FUNCS */ +#endif /* ETHR_INCLUDE_DW_ATOMIC_IMPL__ */ diff --git a/erts/include/internal/gcc/ethr_membar.h b/erts/include/internal/gcc/ethr_membar.h index 7d428fc68e..d2d36907f3 100644 --- a/erts/include/internal/gcc/ethr_membar.h +++ b/erts/include/internal/gcc/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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,56 +18,196 @@ */ /* - * Description: Memory barriers when using gcc's builtins + * Description: Memory barriers when using gcc's __atomic and + * __sync builtins * Author: Rickard Green + * + * Note: The C11 memory model implemented by gcc's __atomic + * builtins does not match the ethread API very well. + * + * A function with a barrier postfix in the ethread atomic + * API needs to ensure that all stores and loads are + * ordered around it according to the semantics of the + * barrier specified. + * + * The C11 aproch is different. The __atomic builtins + * API takes a memory model parameter. Assuming that all + * memory syncronizations using the involved atomic + * variables are made using this API, the synchronizations + * will adhere to the memory models used. That is, you do + * *not* know how loads and stores will be ordered around + * a specific __atomic operation in the general case. You + * only know the total effect of the combination of + * operations issued will adhere to the model. + * + * This limits how we can use the __atomic builtins. What + * we cannot use: + * + * 1. We cannot rely on __atomic_thread_fence() to issue + * any specific memory barriers at all. This regardless + * of memory model parameter passed. That is, we cannot + * use the __atomic_thread_fence() builtin at all. + * + * Why is this? If all __atomic builtins accessing + * memory issue memory barriers, __atomic_thread_fence() + * does not have to issue memory barriers. The + * implementation for the Itanium architecture is an + * example of this. Even using the __ATOMIC_RELAXED + * memory model all __atomic builtins accessing memory + * will issue memory barriers. Due to this no memory + * barriers at all will be issued by + * __atomic_thread_fence() using either one of the + * __ATOMIC_CONSUME, __ATOMIC_ACQUIRE, or + * __ATOMIC_RELEASE memory models. + * + * 2. We cannot rely on any __atomic builtin with the + * __ATOMIC_SEQ_CST memory model parameters to + * issue any specific memory barriers. That is, we + * cannot use these memory models at all. + * + * Why is this? Since all synchronizations is expected + * to be made using the __atomic builtins, memory + * barriers only have to be issued by some of them, + * and you do not know which ones wont issue memory + * barriers. + * + * One can easily be fooled into believing that when + * using the __ATOMIC_SEQ_CST memory model on all + * operations, all operations will issue full memory + * barriers. This is however not the case. The + * implementation for the x86_64 architecture is an + * example of this. Since all operations except loads + * issue full memory barriers, no memory barriers at + * all is issued by loads. This could also be + * implemented by issuing a full memory barrier on + * loads, but no barrier at all on stores. + * + * What can be used then? + * 1. All (legacy) __sync builtins implying full memory + * barriers issued. + * 2. All __atomic builtins using the __ATOMIC_RELAXED + * memory model can, of course, be used. This since + * no ordering guarantees at all are made. + * 3. All __atomic builtins accessing memory using the + * __ATOMIC_ACQUIRE and __ATOMIC_RELEASE memory + * models. This since an __atomic builtin memory + * access using the __ATOMIC_ACQUIRE must at least + * issue an aquire memory barrier and an __atomic + * builtin memory acess with the __ATOMIC_RELEASE + * memory model must at least issue a release memory + * barrier. Otherwise the two can not be paired. + * 4. All __atomic builtins accessing memory using the + * __ATOMIC_CONSUME builtin can be used for the same + * reason __ATOMIC_ACQUIRE can be used. The ethread + * atomic framework implementing the ethread API + * using native implementations does not expect the + * native implementations to produce versions with + * data dependent read barriers, so until the + * framework is changed we haven't got any use for + * for it. + * + * For some architectures we have our own memory barrier + * implementations. We prefer to use these since they + * should be as fine grained as possible. For other + * architectures we use the __sync_synchronize() builtin + * which issue a full memory barrier. For these + * architectures we have to assume that all loads and + * stores can be reordered without limitation. That is, + * unnecessary memory barriers will be issued if such + * reordering actually cannot occur. */ -#ifndef ETHR_GCC_MEMBAR_H__ -#define ETHR_GCC_MEMBAR_H__ +/* + * We prefer to use our own memory barrier implementation if + * such exist instead of using __sync_synchronize()... + */ +#if defined(__i386__) || defined(__x86_64__) +# include "../i386/ethr_membar.h" +#elif defined(__sparc__) +# include "../sparc32/ethr_membar.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +# include "../ppc32/ethr_membar.h" +#elif !defined(ETHR_GCC_ATOMIC_MEMBAR_H__) \ + && (ETHR_HAVE_GCC_ASM_ARM_DMB_INSTRUCTION \ + || ETHR_HAVE___sync_synchronize \ + || (ETHR_HAVE___sync_val_compare_and_swap & 12)) +#define ETHR_GCC_ATOMIC_MEMBAR_H__ #define ETHR_LoadLoad (1 << 0) #define ETHR_LoadStore (1 << 1) #define ETHR_StoreLoad (1 << 2) #define ETHR_StoreStore (1 << 3) +#define ETHR_COMPILER_BARRIER __asm__ __volatile__("" : : : "memory") + +#if ETHR_HAVE_GCC_ASM_ARM_DMB_INSTRUCTION + +static __inline__ __attribute__((__always_inline__)) void +ethr_full_fence__(void) +{ + __asm__ __volatile__("dmb sy" : : : "memory"); +} + +static __inline__ __attribute__((__always_inline__)) void +ethr_store_fence__(void) +{ + __asm__ __volatile__("dmb st" : : : "memory"); +} + +#define ETHR_MEMBAR(B) \ + ETHR_CHOOSE_EXPR((B) == ETHR_StoreStore, ethr_store_fence__(), ethr_full_fence__()) + +#elif ETHR_HAVE___sync_synchronize + +static __inline__ __attribute__((__always_inline__)) void +ethr_full_fence__(void) +{ + /* + * The compiler barriers are here to fix missing clobbers + * in __sync_synchronize() when using buggy LLVM + * implementation of __sync_synchronize(). They + * do not introduce any unnecessary overhead when used + * here, so we use them for all systems. + */ + ETHR_COMPILER_BARRIER; + __sync_synchronize(); + ETHR_COMPILER_BARRIER; +} + +#else /* !ETHR_HAVE___sync_synchronize */ + /* - * According to the documentation __sync_synchronize() will - * issue a full memory barrier. However, __sync_synchronize() - * is known to erroneously be a noop on at least some - * platforms with some gcc versions. This has suposedly been - * fixed in some gcc version, but we don't know from which - * version. Therefore, we only use it when it has been - * verified to work. Otherwise we use the workaround - * below. + * Buggy __sync_synchronize(); call __sync_val_compare_and_swap() + * instead which imply a full memory barrier (and hope that one + * isn't buggy too). */ -#if defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP32) +#if (ETHR_HAVE___sync_val_compare_and_swap & 4) # define ETHR_MB_T__ ethr_sint32_t -#elif defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64) +#elif (ETHR_HAVE___sync_val_compare_and_swap & 8) # define ETHR_MB_T__ ethr_sint64_t -#else -# error "No __sync_val_compare_and_swap" #endif -#define ETHR_SYNC_SYNCHRONIZE_WORKAROUND__ \ -do { \ - volatile ETHR_MB_T__ x___ = 0; \ - (void) __sync_val_compare_and_swap(&x___, (ETHR_MB_T__) 0, (ETHR_MB_T__) 1); \ -} while (0) -#define ETHR_COMPILER_BARRIER __asm__ __volatile__("" : : : "memory") +static __inline__ __attribute__((__always_inline__)) void +ethr_full_fence__(void) +{ + volatile ETHR_MB_T__ x = 0; + (void) __sync_val_compare_and_swap(&x, (ETHR_MB_T__) 0, (ETHR_MB_T__) 1); +} -#if defined(__mips__) && ETHR_AT_LEAST_GCC_VSN__(4, 2, 0) -# define ETHR_MEMBAR(B) __sync_synchronize() -# define ETHR_READ_DEPEND_MEMORY_BARRIER __sync_synchronize() -#elif ((defined(__powerpc__) || defined(__ppc__)) \ - && ETHR_AT_LEAST_GCC_VSN__(4, 1, 2)) -# define ETHR_MEMBAR(B) __sync_synchronize() -#else /* Use workaround */ -# define ETHR_MEMBAR(B) \ - ETHR_SYNC_SYNCHRONIZE_WORKAROUND__ -# define ETHR_READ_DEPEND_MEMORY_BARRIER \ - ETHR_SYNC_SYNCHRONIZE_WORKAROUND__ +#endif /* !ETHR_HAVE___sync_synchronize */ + +#ifndef ETHR_MEMBAR +# define ETHR_MEMBAR(B) ethr_full_fence__() #endif +/* + * Define ETHR_READ_DEPEND_MEMORY_BARRIER for all architechtures + * not known to order data dependent loads + */ + +#if !defined(__ia64__) && !defined(__arm__) +# define ETHR_READ_DEPEND_MEMORY_BARRIER ETHR_MEMBAR(ETHR_LoadLoad) +#endif -#endif /* ETHR_GCC_MEMBAR_H__ */ +#endif /* ETHR_GCC_ATOMIC_MEMBAR_H__ */ diff --git a/erts/include/internal/gcc/ethread.h b/erts/include/internal/gcc/ethread.h index 365a3535cf..be3e1da90e 100644 --- a/erts/include/internal/gcc/ethread.h +++ b/erts/include/internal/gcc/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. 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 @@ -18,20 +18,292 @@ */ /* - * Description: Native atomic ethread support when using gcc + * Description: Native atomic ethread support when using gcc's __atomic + * and __sync builtins * Author: Rickard Green */ -#ifndef ETHREAD_GCC_H__ -#define ETHREAD_GCC_H__ - -#if defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP32) \ - || defined(ETHR_HAVE___SYNC_VAL_COMPARE_AND_SWAP64) +#if !defined(ETHREAD_GCC_NATIVE_H__) && ETHR_GCC_COMPILER +#define ETHREAD_GCC_NATIVE_H__ #ifndef ETHR_MEMBAR # include "ethr_membar.h" #endif +#define ETHR_GCC_VERSIONS_MASK__ 28 + +#undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ +#undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ +#undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ +#undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ +#undef ETHR_GCC_RELAXED_VERSIONS__ +#undef ETHR_GCC_RELAXED_MOD_VERSIONS__ +#undef ETHR_GCC_ACQB_VERSIONS__ +#undef ETHR_GCC_ACQB_MOD_VERSIONS__ +#undef ETHR_GCC_RELB_VERSIONS__ +#undef ETHR_GCC_RELB_MOD_VERSIONS__ +#undef ETHR_GCC_MB_MOD_VERSIONS__ + +/* + * True GNU GCCs before version 4.8 do not emit a memory barrier + * after the load in the __atomic_load_n(_, __ATOMIC_ACQUIRE) + * case (which is needed on most architectures). + */ +#undef ETHR___atomic_load_ACQUIRE_barrier_bug +#if ETHR_GCC_COMPILER != ETHR_GCC_COMPILER_TRUE +/* + * A gcc compatible compiler. We have no information + * about the existence of this bug, but we assume + * that it is not impossible that it could have + * been "inherited". Therefore, until we are certain + * that the bug does not exist, we assume that it + * does. + */ +# define ETHR___atomic_load_ACQUIRE_barrier_bug ETHR_GCC_VERSIONS_MASK__ +#elif !ETHR_AT_LEAST_GCC_VSN__(4, 8, 0) +/* True gcc of version < 4.8, i.e., bug exist... */ +# define ETHR___atomic_load_ACQUIRE_barrier_bug ETHR_GCC_VERSIONS_MASK__ +#else /* True gcc of version >= 4.8 */ +/* + * Sizes less than or equal to word size have been fixed, + * but double word size has not been fixed. + */ +# if ETHR_SIZEOF_PTR == 8 +# define ETHR___atomic_load_ACQUIRE_barrier_bug \ + (~(8|4) & ETHR_GCC_VERSIONS_MASK__) +# elif ETHR_SIZEOF_PTR == 4 +# define ETHR___atomic_load_ACQUIRE_barrier_bug \ + (~4 & ETHR_GCC_VERSIONS_MASK__) +# else +# error word size not supported +# endif +#endif + +#define ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ 0 +#define ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ 0 +#define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ 0 +#define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ 0 +#define ETHR_GCC_RELAXED_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +#define ETHR_GCC_RELAXED_MOD_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ + +#if ETHR_TRUST_GCC_ATOMIC_BUILTINS_MEMORY_BARRIERS +# define ETHR_GCC_ACQB_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# define ETHR_GCC_ACQB_MOD_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# define ETHR_GCC_RELB_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# define ETHR_GCC_RELB_MOD_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +#else +/* + * This is currently the default (on most platforms) since + * we've seen too many memory barrier bugs produced by gcc... + */ +# define ETHR_GCC_ACQB_VERSIONS__ 0 +# define ETHR_GCC_ACQB_MOD_VERSIONS__ 0 +# define ETHR_GCC_RELB_VERSIONS__ 0 +# define ETHR_GCC_RELB_MOD_VERSIONS__ 0 +#endif +/* + * In the general case we do not want any full barrier versions + * if we can implement more relaxed ones (using __atomic_* builtins). + * This since the implementations normally need extra memory barrier + * instructions to implement these. The x86/x86_64 implementations + * are an exception see below. + */ +#define ETHR_GCC_MB_MOD_VERSIONS__ \ + (ETHR_GCC_VERSIONS_MASK__ & ~ETHR_HAVE___atomic_compare_exchange_n) + +#if ETHR_SIZEOF_PTR == 8 +# define ETHR_GCC_VOLATILE_BIT_MASK__ 12 +#elif ETHR_SIZEOF_PTR == 4 +# define ETHR_GCC_VOLATILE_BIT_MASK__ 4 +#endif + +#if defined(__i386__) || defined(__x86_64__) || defined(__sparc__) \ + || defined(__powerpc__) || defined(__ppc__) || defined(__mips__) \ + || defined(__alpha__) || defined(__ia64__) + +/* + * Aligned volatile stores and loads of data smaller + * than or equal to word size are atomic... + */ +# undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ +# define ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ ETHR_GCC_VOLATILE_BIT_MASK__ +# undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ +# define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ ETHR_GCC_VOLATILE_BIT_MASK__ + +#elif defined(__arm__) + +/* volatile stores are problematic on some machines... */ +# undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ +# define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ ETHR_GCC_VOLATILE_BIT_MASK__ + +#endif + +#if defined(__ia64__) + +/* Volatile stores produce stores with release barriers. */ +# undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ +# define ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ ETHR_GCC_VOLATILE_BIT_MASK__ + +/* Volatile loads produce loads with acquire barrier. */ +# undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ +# define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ ETHR_GCC_VOLATILE_BIT_MASK__ + +/* + * We trust gcc to produce acquire/release barriers on itanium. + * Since all atomic ops also have at least acquire or release + * barriers (also when passed the relaxed memory model) it + * would be very inefficient not to use these as native + * barriers on Itanium. + */ +# undef ETHR_GCC_ACQB_VERSIONS__ +# define ETHR_GCC_ACQB_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# undef ETHR_GCC_ACQB_MOD_VERSIONS__ +# define ETHR_GCC_ACQB_MOD_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# undef ETHR_GCC_RELB_VERSIONS__ +# define ETHR_GCC_RELB_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ +# undef ETHR_GCC_RELB_MOD_VERSIONS__ +# define ETHR_GCC_RELB_MOD_VERSIONS__ ETHR_GCC_VERSIONS_MASK__ + +/* + * Itanium is not effected by the load acquire + * bug since the barrier is part of the instruction + * on Itanium (ld.acq), and not a separate instruction + * as on most platforms. + */ +# undef ETHR___atomic_load_ACQUIRE_barrier_bug +# define ETHR___atomic_load_ACQUIRE_barrier_bug 0 + +/* + * No point exposing relaxed versions since they are + * implemended using either acquire or release + * barriers. + */ +# undef ETHR_GCC_RELAXED_VERSIONS__ +# define ETHR_GCC_RELAXED_VERSIONS__ 0 + +/* #endif defined(__ia64__) */ +#elif defined(__i386__) || defined(__x86_64__) + +/* + * Want full barrier versions of all modification + * operations since all of these are implemented + * using locked instructions implying full memory + * barriers. + */ +# undef ETHR_GCC_MB_MOD_VERSIONS__ +# define ETHR_GCC_MB_MOD_VERSIONS__ ETHR_HAVE___sync_val_compare_and_swap + +/* + * No point exposing acquire/release versions + * when we got full memory barrier versions + * of modification operations since all of these + * are implemented using locked instructions + * implying full memory barriers. + */ +# if ETHR_GCC_ACQB_MOD_VERSIONS__ +# undef ETHR_GCC_ACQB_MOD_VERSIONS__ +# define ETHR_GCC_ACQB_MOD_VERSIONS__ \ + (ETHR_GCC_VERSIONS_MASK__ & ~ETHR_HAVE___sync_val_compare_and_swap) +# endif +# if ETHR_GCC_RELB_MOD_VERSIONS__ +# undef ETHR_GCC_RELB_MOD_VERSIONS__ +# define ETHR_GCC_RELB_MOD_VERSIONS__ \ + (ETHR_GCC_VERSIONS_MASK__ & ~ETHR_HAVE___sync_val_compare_and_swap) +# endif + +# ifdef ETHR_X86_OUT_OF_ORDER + +/* See above... */ +# undef ETHR_GCC_RELAXED_MOD_VERSIONS__ +# define ETHR_GCC_RELAXED_MOD_VERSIONS__ 0 + +# else /* !ETHR_X86_OUT_OF_ORDER, i.e., we don't use any x86-OOO instructions... */ + +/* + * Not effected by the load acquire barrier bug, + * since no barrier at all is needed for a load + * acquire... + */ +# undef ETHR___atomic_load_ACQUIRE_barrier_bug +# define ETHR___atomic_load_ACQUIRE_barrier_bug 0 + +/* Stores imply release barriers semantics. */ +# undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ +# define ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ ETHR_GCC_VOLATILE_BIT_MASK__ + +/* Loads imply acquire barrier semantics. */ +# undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ +# define ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ ETHR_GCC_VOLATILE_BIT_MASK__ + +/* + * Trust load acquire and store release for sizes + * where volatile operation implies these barrier + * semantics since no barriers are needed. + */ +# if !ETHR_GCC_ACQB_VERSIONS__ +# undef ETHR_GCC_ACQB_VERSIONS__ +# define ETHR_GCC_ACQB_VERSIONS__ ETHR_GCC_VOLATILE_BIT_MASK__ +# endif +# if !ETHR_GCC_RELB_VERSIONS__ +# undef ETHR_GCC_RELB_VERSIONS__ +# define ETHR_GCC_RELB_VERSIONS__ ETHR_GCC_VOLATILE_BIT_MASK__ +# endif + +/* + * No point exposing relaxed versions at all since + * all mod operations are implemented with locked + * instructions implying full memory barriers and + * volatile store and load imply release and + * acquire barrier semantics. + */ +# undef ETHR_GCC_RELAXED_VERSIONS__ +# define ETHR_GCC_RELAXED_VERSIONS__ 0 + +# endif /* !ETHR_X86_OUT_OF_ORDER */ + +/* #endif defined(__i386__) || defined(__x86_64__) */ +#elif defined(__powerpc__) || defined(__ppc__) + +# if !defined(ETHR_PPC_HAVE_LWSYNC) +/* + * Release barriers are typically implemented using + * the lwsync instruction. We want our runtime + * configure test to determine if the lwsync + * instruction is available on the system or not + * before we use it. Therefore, do not implement any + * native ops using the __ATOMIC_RELEASE model. + */ +# undef ETHR_GCC_RELB_VERSIONS__ +# define ETHR_GCC_RELB_VERSIONS__ 0 +# if defined(ETHR_GCC_IMPLEMENT_ACQB_USING_LWSYNC) +/* + * Acquire barriers are usually implemented by other means + * than lwsync, but can be implemented using lwsync. Define + * ETHR_GCC_IMPLEMENT_ACQB_USING_LWSYNC if acquire barriers + * are implemented using lwsync. + */ +# undef ETHR_GCC_ACQB_VERSIONS__ +# define ETHR_GCC_ACQB_VERSIONS__ 0 +# endif +# endif + +#endif /* defined(__powerpc__) || defined(__ppc__) */ + +#if !ETHR_GCC_RELAXED_VERSIONS__ +# undef ETHR_GCC_RELAXED_MOD_VERSIONS__ +# define ETHR_GCC_RELAXED_MOD_VERSIONS__ 0 +#endif + +#if !ETHR_GCC_ACQB_VERSIONS__ +# undef ETHR_GCC_ACQB_MOD_VERSIONS__ +# define ETHR_GCC_ACQB_MOD_VERSIONS__ 0 +#endif + +#if !ETHR_GCC_RELB_VERSIONS__ +# undef ETHR_GCC_RELB_MOD_VERSIONS__ +# define ETHR_GCC_RELB_MOD_VERSIONS__ 0 +#endif + #if !defined(ETHR_HAVE_NATIVE_ATOMIC32) # define ETHR_ATOMIC_WANT_32BIT_IMPL__ # include "ethr_atomic.h" @@ -42,12 +314,51 @@ # include "ethr_atomic.h" #endif +#if defined(__x86_64__) +/* + * No instructions available for native implementation + * of these for dw-atomics... + */ +# undef ETHR_GCC_RELAXED_VERSIONS__ +# define ETHR_GCC_RELAXED_VERSIONS__ 0 +# undef ETHR_GCC_ACQB_VERSIONS__ +# define ETHR_GCC_ACQB_VERSIONS__ 0 +# undef ETHR_GCC_RELB_VERSIONS__ +# define ETHR_GCC_RELB_VERSIONS__ 0 +#endif + +#if !ETHR_GCC_RELAXED_VERSIONS__ +# undef ETHR_GCC_RELAXED_MOD_VERSIONS__ +# define ETHR_GCC_RELAXED_MOD_VERSIONS__ 0 +#endif + +#if !ETHR_GCC_ACQB_VERSIONS__ +# undef ETHR_GCC_ACQB_MOD_VERSIONS__ +# define ETHR_GCC_ACQB_MOD_VERSIONS__ 0 +#endif + +#if !ETHR_GCC_RELB_VERSIONS__ +# undef ETHR_GCC_RELB_MOD_VERSIONS__ +# define ETHR_GCC_RELB_MOD_VERSIONS__ 0 +#endif + #if (!defined(ETHR_HAVE_NATIVE_DW_ATOMIC) \ && !(ETHR_SIZEOF_PTR == 4 && defined(ETHR_HAVE_NATIVE_ATOMIC64)) \ && !(ETHR_SIZEOF_PTR == 8 && defined(ETHR_HAVE_NATIVE_ATOMIC128))) # include "ethr_dw_atomic.h" #endif -#endif +#undef ETHR___atomic_load_ACQUIRE_barrier_bug +#undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE__ +#undef ETHR_GCC_VOLATILE_STORE_IS_ATOMIC_STORE_RELB__ +#undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD__ +#undef ETHR_GCC_VOLATILE_LOAD_IS_ATOMIC_LOAD_ACQB__ +#undef ETHR_GCC_RELAXED_VERSIONS__ +#undef ETHR_GCC_RELB_VERSIONS__ +#undef ETHR_GCC_RELB_VERSIONS__ +#undef ETHR_GCC_RELAXED_MOD_VERSIONS__ +#undef ETHR_GCC_ACQB_MOD_VERSIONS__ +#undef ETHR_GCC_RELB_MOD_VERSIONS__ +#undef ETHR_GCC_MB_MOD_VERSIONS__ -#endif +#endif /* ETHREAD_GCC_NATIVE_H__ */ diff --git a/erts/include/internal/pthread/ethr_event.h b/erts/include/internal/pthread/ethr_event.h index d0a77990cc..f67bac858b 100644 --- a/erts/include/internal/pthread/ethr_event.h +++ b/erts/include/internal/pthread/ethr_event.h @@ -46,12 +46,12 @@ typedef struct { ethr_atomic32_t futex; } ethr_event; -#define ETHR_FUTEX__(FTX, OP, VAL) \ +#define ETHR_FUTEX__(FTX, OP, VAL, TIMEOUT) \ (-1 == syscall(__NR_futex, \ (void *) ethr_atomic32_addr((FTX)), \ (OP), \ (int) (VAL), \ - NULL, \ + (TIMEOUT), \ NULL, \ 0) \ ? errno : 0) @@ -64,7 +64,7 @@ ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) ethr_sint32_t val; val = ethr_atomic32_xchg_mb(&e->futex, ETHR_EVENT_ON__); if (val == ETHR_EVENT_OFF_WAITER__) { - int res = ETHR_FUTEX__(&e->futex, ETHR_FUTEX_WAKE__, 1); + int res = ETHR_FUTEX__(&e->futex, ETHR_FUTEX_WAKE__, 1, NULL); if (res != 0) ETHR_FATAL_ERROR__(res); } @@ -80,35 +80,58 @@ ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e) #endif #elif defined(ETHR_PTHREADS) -/* --- Posix mutex/cond implementation of events ---------------------------- */ +/* --- Posix mutex/cond pipe/select implementation of events ---------------- */ + typedef struct { ethr_atomic32_t state; pthread_mutex_t mtx; pthread_cond_t cnd; + int fd[2]; } ethr_event; -#define ETHR_EVENT_OFF_WAITER__ -1L -#define ETHR_EVENT_OFF__ 1L -#define ETHR_EVENT_ON__ 0L +#define ETHR_EVENT_OFF_WAITER_SELECT__ ((ethr_sint32_t) -2) +#define ETHR_EVENT_OFF_WAITER__ ((ethr_sint32_t) -1) +#define ETHR_EVENT_OFF__ ((ethr_sint32_t) 1) +#define ETHR_EVENT_ON__ ((ethr_sint32_t) 0) + +#define ETHR_EVENT_IS_WAITING__(VAL) ((VAL) < 0) #if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) +#ifndef ETHR_HAVE_PTHREAD_TIMED_COND_MONOTONIC +#include <unistd.h> +#include <errno.h> +#endif + static void ETHR_INLINE ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) { ethr_sint32_t val; val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__); - if (val == ETHR_EVENT_OFF_WAITER__) { - int res = pthread_mutex_lock(&e->mtx); - if (res != 0) - ETHR_FATAL_ERROR__(res); - res = pthread_cond_signal(&e->cnd); - if (res != 0) - ETHR_FATAL_ERROR__(res); - res = pthread_mutex_unlock(&e->mtx); - if (res != 0) - ETHR_FATAL_ERROR__(res); + if (ETHR_EVENT_IS_WAITING__(val)) { + int res; + if (val == ETHR_EVENT_OFF_WAITER_SELECT__) { + ssize_t wres; + int fd = e->fd[1]; + ETHR_ASSERT(fd >= 0); + do { + wres = write(fd, "!", 1); + } while (wres < 0 && errno == EINTR); + if (wres < 0 && errno != EAGAIN && errno != EWOULDBLOCK) + ETHR_FATAL_ERROR__(errno); + } + else { + res = pthread_mutex_lock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + res = pthread_cond_signal(&e->cnd); + if (res != 0) + ETHR_FATAL_ERROR__(res); + res = pthread_mutex_unlock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } } } @@ -127,6 +150,8 @@ int ethr_event_init(ethr_event *e); int ethr_event_destroy(ethr_event *e); int ethr_event_wait(ethr_event *e); int ethr_event_swait(ethr_event *e, int spincount); +int ethr_event_twait(ethr_event *e, ethr_sint64_t timeout); +int ethr_event_stwait(ethr_event *e, int spincount, ethr_sint64_t timeout); #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) void ethr_event_set(ethr_event *e); void ethr_event_reset(ethr_event *e); diff --git a/erts/include/internal/win/ethr_event.h b/erts/include/internal/win/ethr_event.h index 6363174a74..95e681983f 100644 --- a/erts/include/internal/win/ethr_event.h +++ b/erts/include/internal/win/ethr_event.h @@ -58,6 +58,8 @@ int ethr_event_init(ethr_event *e); int ethr_event_destroy(ethr_event *e); int ethr_event_wait(ethr_event *e); int ethr_event_swait(ethr_event *e, int spincount); +int ethr_event_twait(ethr_event *e, ethr_sint64_t timeout); +int ethr_event_stwait(ethr_event *e, int spincount, ethr_sint64_t timeout); #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) void ethr_event_set(ethr_event *e); void ethr_event_reset(ethr_event *e); diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index b77f2178f2..1ba51882c3 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -148,6 +148,8 @@ ethr_init_common__(ethr_init_data *id) { int res; + ethr_init_event__(); + #if defined(ETHR_X86_RUNTIME_CONF__) x86_init(); #endif diff --git a/erts/lib_src/pthread/ethr_event.c b/erts/lib_src/pthread/ethr_event.c index 9434d60d0a..b35c599365 100644 --- a/erts/lib_src/pthread/ethr_event.c +++ b/erts/lib_src/pthread/ethr_event.c @@ -29,6 +29,9 @@ #endif #include "ethread.h" +#undef ETHR_INCLUDE_MONOTONIC_CLOCK__ +#define ETHR_INCLUDE_MONOTONIC_CLOCK__ +#include "ethr_internal.h" #if defined(ETHR_LINUX_FUTEX_IMPL__) /* --- Linux futex implementation of ethread events ------------------------- */ @@ -38,6 +41,12 @@ #define ETHR_YIELD_AFTER_BUSY_LOOPS 50 +void +ethr_init_event__(void) +{ + +} + int ethr_event_init(ethr_event *e) { @@ -52,21 +61,43 @@ ethr_event_destroy(ethr_event *e) } static ETHR_INLINE int -wait__(ethr_event *e, int spincount) +wait__(ethr_event *e, int spincount, ethr_sint64_t timeout) { unsigned sc = spincount; int res; ethr_sint32_t val; int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + ethr_sint64_t time = 0; /* SHUT UP annoying faulty warning... */ + struct timespec ts, *tsp; +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + ethr_sint64_t start = 0; /* SHUT UP annoying faulty warning... */ +#endif if (spincount < 0) ETHR_FATAL_ERROR__(EINVAL); + if (timeout < 0) { + tsp = NULL; + } + else { + tsp = &ts; + time = timeout; + if (spincount == 0) { + val = ethr_atomic32_read(&e->futex); + if (val == ETHR_EVENT_ON__) + goto return_event_on; + goto set_timeout; + } +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + start = ethr_get_monotonic_time(); +#endif + } + while (1) { while (1) { val = ethr_atomic32_read(&e->futex); if (val == ETHR_EVENT_ON__) - return 0; + goto return_event_on; if (sc == 0) break; sc--; @@ -79,44 +110,147 @@ wait__(ethr_event *e, int spincount) } } + if (timeout >= 0) { +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + time = timeout - (ethr_get_monotonic_time() - start); +#endif + set_timeout: + if (time <= 0) { + val = ethr_atomic32_read(&e->futex); + if (val == ETHR_EVENT_ON__) + goto return_event_on; + return ETIMEDOUT; + } + ts.tv_sec = time / (1000*1000*1000); + ts.tv_nsec = time % (1000*1000*1000); + } + if (val != ETHR_EVENT_OFF_WAITER__) { val = ethr_atomic32_cmpxchg(&e->futex, ETHR_EVENT_OFF_WAITER__, ETHR_EVENT_OFF__); if (val == ETHR_EVENT_ON__) - return 0; + goto return_event_on; ETHR_ASSERT(val == ETHR_EVENT_OFF__); } res = ETHR_FUTEX__(&e->futex, ETHR_FUTEX_WAIT__, - ETHR_EVENT_OFF_WAITER__); - if (res == EINTR) + ETHR_EVENT_OFF_WAITER__, + tsp); + switch (res) { + case EINTR: + case ETIMEDOUT: + return res; + case 0: + case EWOULDBLOCK: break; - if (res != 0 && res != EWOULDBLOCK) + default: ETHR_FATAL_ERROR__(res); + } } - return res; +return_event_on: + + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); + + return 0; + } #elif defined(ETHR_PTHREADS) -/* --- Posix mutex/cond implementation of events ---------------------------- */ +/* --- Posix mutex/cond pipe/select implementation of events ---------------- */ + +#include <fcntl.h> +#include <sys/types.h> +#include <sys/uio.h> +#include <unistd.h> +#include <sys/select.h> +#include <errno.h> +#include <string.h> + +static void +setup_nonblocking_pipe(ethr_event *e) +{ + int flgs; + int res; + + res = pipe(e->fd); + if (res != 0) + ETHR_FATAL_ERROR__(errno); + + ETHR_ASSERT(e->fd[0] >= 0 && e->fd[1] >= 0); + + flgs = fcntl(e->fd[0], F_GETFL, 0); + fcntl(e->fd[0], F_SETFL, flgs | O_NONBLOCK); + flgs = fcntl(e->fd[1], F_GETFL, 0); + fcntl(e->fd[1], F_SETFL, flgs | O_NONBLOCK); + + ETHR_MEMBAR(ETHR_StoreStore); +} + +#define ETHR_EVENT_INVALID_FD__ -1 +#define ETHR_EVENT_COND_TIMEDWAIT__ -2 + +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC +static pthread_condattr_t monotonic_clock_cond_attr; +#endif +static pthread_condattr_t *monotonic_clock_cond_attr_p; + +#ifndef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME +# undef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC +#endif +#ifndef ETHR_MONOTONIC_CLOCK_ID +# undef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC +#endif + +void +ethr_init_event__(void) +{ + monotonic_clock_cond_attr_p = NULL; +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + if (!ethr_get_monotonic_time_is_broken() + && pthread_condattr_init(&monotonic_clock_cond_attr) == 0) { + if (pthread_condattr_setclock(&monotonic_clock_cond_attr, + ETHR_MONOTONIC_CLOCK_ID) == 0) + monotonic_clock_cond_attr_p = &monotonic_clock_cond_attr; + else + pthread_condattr_destroy(&monotonic_clock_cond_attr); + } +#endif +} int ethr_event_init(ethr_event *e) { int res; + ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__); + res = pthread_mutex_init(&e->mtx, NULL); if (res != 0) return res; - res = pthread_cond_init(&e->cnd, NULL); + + res = pthread_cond_init(&e->cnd, monotonic_clock_cond_attr_p); if (res != 0) { pthread_mutex_destroy(&e->mtx); return res; } + +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + /* + * If ethr_get_monotonic_time() is broken we + * fall back on the pipe/select solution... + */ + if (monotonic_clock_cond_attr_p) { + e->fd[0] = e->fd[1] = ETHR_EVENT_COND_TIMEDWAIT__; + return 0; + } +#endif + + e->fd[0] = e->fd[1] = ETHR_EVENT_INVALID_FD__; + return 0; } @@ -124,6 +258,10 @@ int ethr_event_destroy(ethr_event *e) { int res; + if (e->fd[0] >= 0) { + close(e->fd[0]); + close(e->fd[1]); + } res = pthread_mutex_destroy(&e->mtx); if (res != 0) return res; @@ -134,12 +272,58 @@ ethr_event_destroy(ethr_event *e) } static ETHR_INLINE int -wait__(ethr_event *e, int spincount) +wait__(ethr_event *e, int spincount, ethr_sint64_t timeout) { int sc = spincount; ethr_sint32_t val; int res, ulres; int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + ethr_sint64_t time = 0; /* SHUT UP annoying faulty warning... */ +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + ethr_sint64_t start = 0; /* SHUT UP annoying faulty warning... */ +#endif +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + struct timespec cond_timeout; +#endif + + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) + goto return_event_on; + + if (timeout < 0) { + if (spincount == 0) + goto set_event_off_waiter; + } + if (timeout == 0) + return ETIMEDOUT; + else { + time = timeout; + switch (e->fd[0]) { + case ETHR_EVENT_INVALID_FD__: +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + start = ethr_get_monotonic_time(); +#endif + setup_nonblocking_pipe(e); + break; +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + case ETHR_EVENT_COND_TIMEDWAIT__: + time += ethr_get_monotonic_time(); + cond_timeout.tv_sec = time / (1000*1000*1000); + cond_timeout.tv_nsec = time % (1000*1000*1000); + if (spincount == 0) + goto set_event_off_waiter; + break; +#endif + default: + /* Already initialized pipe... */ + if (spincount == 0) + goto set_select_timeout; +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + start = ethr_get_monotonic_time(); +#endif + break; + } + } if (spincount < 0) ETHR_FATAL_ERROR__(EINVAL); @@ -147,7 +331,8 @@ wait__(ethr_event *e, int spincount) while (1) { val = ethr_atomic32_read(&e->state); if (val == ETHR_EVENT_ON__) - return 0; + goto return_event_on; + if (sc == 0) break; sc--; @@ -160,40 +345,150 @@ wait__(ethr_event *e, int spincount) } } - if (val != ETHR_EVENT_OFF_WAITER__) { - val = ethr_atomic32_cmpxchg(&e->state, - ETHR_EVENT_OFF_WAITER__, - ETHR_EVENT_OFF__); - if (val == ETHR_EVENT_ON__) - return 0; - ETHR_ASSERT(val == ETHR_EVENT_OFF__); + if (timeout < 0 +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + || e->fd[0] == ETHR_EVENT_COND_TIMEDWAIT__ +#endif + ) { + + set_event_off_waiter: + + if (val != ETHR_EVENT_OFF_WAITER__) { + ethr_sint32_t act; + act = ethr_atomic32_cmpxchg(&e->state, + ETHR_EVENT_OFF_WAITER__, + val); + if (act == ETHR_EVENT_ON__) + goto return_event_on; + ETHR_ASSERT(act == val); + } + + res = pthread_mutex_lock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + + while (1) { + + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) { + ETHR_ASSERT(res == 0); + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); + break; + } + +#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC + if (timeout > 0) { + res = pthread_cond_timedwait(&e->cnd, &e->mtx, &cond_timeout); + if (res == EINTR || res == ETIMEDOUT) + break; + } + else +#endif + { + res = pthread_cond_wait(&e->cnd, &e->mtx); + if (res == EINTR) + break; + } + if (res != 0) + ETHR_FATAL_ERROR__(res); + } + + ulres = pthread_mutex_unlock(&e->mtx); + if (ulres != 0) + ETHR_FATAL_ERROR__(ulres); + } + else { + int fd; + int sres; + ssize_t rres; + fd_set rset; + fd_set eset; + struct timeval select_timeout; + +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + time -= ethr_get_monotonic_time() - start; + if (time <= 0) + return ETIMEDOUT; +#endif - ETHR_ASSERT(val == ETHR_EVENT_OFF_WAITER__ - || val == ETHR_EVENT_OFF__); + set_select_timeout: - res = pthread_mutex_lock(&e->mtx); - if (res != 0) - ETHR_FATAL_ERROR__(res); + ETHR_ASSERT(time > 0); - while (1) { + /* + * timeout in nano-second, but we can only wait + * for micro-seconds... + */ + time = ((time - 1) / 1000) + 1; + + select_timeout.tv_sec = time / (1000*1000); + select_timeout.tv_usec = time % (1000*1000); + + ETHR_ASSERT(val != ETHR_EVENT_ON__); + + fd = e->fd[0]; + + /* Cleanup pipe... */ + do { + char buf[64]; + rres = read(fd, buf, sizeof(buf)); + } while (rres > 0 || (rres < 0 && errno == EINTR)); + if (rres < 0 && errno != EAGAIN && errno != EWOULDBLOCK) + ETHR_FATAL_ERROR__(errno); + + /* + * Need to verify that state is still off + * after cleaning the pipe... + */ + if (val == ETHR_EVENT_OFF_WAITER_SELECT__) { + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) + goto return_event_on; + } + else { + ethr_sint32_t act; + act = ethr_atomic32_cmpxchg(&e->state, + ETHR_EVENT_OFF_WAITER_SELECT__, + val); + if (act == ETHR_EVENT_ON__) + goto return_event_on; + ETHR_ASSERT(act == val); + } + + FD_ZERO(&rset); + FD_SET(fd, &rset); + FD_ZERO(&eset); + FD_SET(fd, &eset); + + sres = select(fd + 1, &rset, NULL, &eset, &select_timeout); + if (sres == 0) + res = ETIMEDOUT; + else { + res = EINTR; + if (sres < 0 && errno != EINTR) + ETHR_FATAL_ERROR__(errno); + /* else: + * Event is *probably* set, but it can be a + * lingering writer. That is, it is important + * that we verify that it actually is set. If + * it isn't, return EINTR (spurious wakeup). + */ + } val = ethr_atomic32_read(&e->state); if (val == ETHR_EVENT_ON__) - break; + goto return_event_on; - res = pthread_cond_wait(&e->cnd, &e->mtx); - if (res == EINTR) - break; - if (res != 0) - ETHR_FATAL_ERROR__(res); } - ulres = pthread_mutex_unlock(&e->mtx); - if (ulres != 0) - ETHR_FATAL_ERROR__(ulres); + return res; + +return_event_on: + + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); - return res; /* 0 || EINTR */ + return 0; } #else @@ -215,11 +510,23 @@ ethr_event_set(ethr_event *e) int ethr_event_wait(ethr_event *e) { - return wait__(e, 0); + return wait__(e, 0, -1); } int ethr_event_swait(ethr_event *e, int spincount) { - return wait__(e, spincount); + return wait__(e, spincount, -1); +} + +int +ethr_event_twait(ethr_event *e, ethr_sint64_t timeout) +{ + return wait__(e, 0, timeout); +} + +int +ethr_event_stwait(ethr_event *e, int spincount, ethr_sint64_t timeout) +{ + return wait__(e, spincount, timeout); } diff --git a/erts/lib_src/pthread/ethread.c b/erts/lib_src/pthread/ethread.c index 7cf38580c5..c0b1dad0b6 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -50,6 +50,8 @@ #define ETHREAD_IMPL__ #include "ethread.h" +#undef ETHR_INCLUDE_MONOTONIC_CLOCK__ +#define ETHR_INCLUDE_MONOTONIC_CLOCK__ #include "ethr_internal.h" #ifndef ETHR_HAVE_ETHREAD_DEFINES @@ -237,6 +239,10 @@ ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx) #endif /* ETHR_X86_RUNTIME_CONF__ */ +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME +static void init_get_monotonic_time(void); +#endif + /* * -------------------------------------------------------------------------- * Exported functions @@ -259,6 +265,10 @@ ethr_init(ethr_init_data *id) goto error; #endif +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + init_get_monotonic_time(); +#endif + res = ethr_init_common__(id); if (res != 0) goto error; @@ -613,6 +623,144 @@ int ethr_kill(const ethr_tid tid, const int sig) #endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */ +#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME + +static int broken_get_monotonic_time; + +#if defined(ETHR_HAVE_CLOCK_GETTIME_MONOTONIC) +# ifndef ETHR_MONOTONIC_CLOCK_ID +# error ETHR_MONOTONIC_CLOCK_ID should have been defined +# endif + +ethr_sint64_t +ethr_get_monotonic_time(void) +{ + ethr_sint64_t time; + struct timespec ts; + + if (broken_get_monotonic_time) + return (ethr_sint64_t) 0; + + if (0 != clock_gettime(ETHR_MONOTONIC_CLOCK_ID, &ts)) + ETHR_FATAL_ERROR__(errno); + + time = (ethr_sint64_t) ts.tv_sec; + time *= (ethr_sint64_t) 1000*1000*1000; + time += (ethr_sint64_t) ts.tv_nsec; + return time; +} + +#elif defined(ETHR_HAVE_MACH_CLOCK_GET_TIME) +# ifndef ETHR_MONOTONIC_CLOCK_ID +# error ETHR_MONOTONIC_CLOCK_ID should have been defined +# endif + +ethr_sint64_t +ethr_get_monotonic_time(void) +{ + ethr_sint64_t time; + kern_return_t res; + clock_serv_t clk_srv; + mach_timespec_t time_spec; + + if (broken_get_monotonic_time) + return (ethr_sint64_t) 0; + + errno = EFAULT; + host_get_clock_service(mach_host_self(), + ETHR_MONOTONIC_CLOCK_ID, + &clk_srv); + res = clock_get_time(clk_srv, &time_spec); + if (res != KERN_SUCCESS) + ETHR_FATAL_ERROR__(errno); + mach_port_deallocate(mach_task_self(), clk_srv); + + time = (ethr_sint64_t) time_spec.tv_sec; + time *= (ethr_sint64_t) 1000*1000*1000; + time += (ethr_sint64_t) time_spec.tv_nsec; + return time; +} + +#elif defined(ETHR_HAVE_GETHRTIME) + +ethr_sint64_t +ethr_get_monotonic_time(void) +{ + if (broken_get_monotonic_time) + return (ethr_sint64_t) 0; + return (ethr_sint64_t) gethrtime(); +} + +#else +#error missing monotonic clock +#endif + +int +ethr_get_monotonic_time_is_broken(void) +{ + return broken_get_monotonic_time; +} + +#include <string.h> +#include <ctype.h> +#include <sys/utsname.h> + +static void +init_get_monotonic_time(void) +{ + struct utsname uts; + int vsn[3]; + int i; + char *c; + + broken_get_monotonic_time = 0; + + (void) uname(&uts); + + for (c = uts.sysname; *c; c++) { + if (isupper((int) *c)) + *c = tolower((int) *c); + } + + c = uts.release; + for (i = 0; i < sizeof(vsn)/sizeof(int); i++) { + if (!isdigit((int) *c)) + vsn[i] = 0; + else { + char *c2 = c; + do { + c2++; + } while (isdigit((int) *c2)); + *c2 = '\0'; + vsn[i] = atoi(c); + c = c2; + c++; + } + } + + if (strcmp("linux", uts.sysname) == 0) { + if (vsn[0] < 2 + || (vsn[0] == 2 && vsn[1] < 6) + || (vsn[0] == 2 && vsn[1] == 6 && vsn[2] < 33)) { + broken_get_monotonic_time = 1; + } + } + else if (strcmp("sunos", uts.sysname) == 0) { + if ((vsn[0] < 5 + || (vsn[0] == 5 && vsn[1] < 8)) +#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF) + && sysconf(_SC_NPROCESSORS_CONF) > 1 +#endif + ) { + broken_get_monotonic_time = 1; + } + } + +} + + +#endif /* ETHR_HAVE_ETHR_GET_MONOTONIC_TIME */ + ETHR_IMPL_NORETURN__ ethr_abort__(void) { diff --git a/erts/lib_src/win/ethr_event.c b/erts/lib_src/win/ethr_event.c index bc2f635c26..a0d506356d 100644 --- a/erts/lib_src/win/ethr_event.c +++ b/erts/lib_src/win/ethr_event.c @@ -25,9 +25,16 @@ #define ETHR_EVENT_IMPL__ #include "ethread.h" +#include "ethr_internal.h" /* --- Windows implementation of thread events ------------------------------ */ +void +ethr_init_event__(void) +{ + +} + int ethr_event_init(ethr_event *e) { @@ -58,11 +65,29 @@ ethr_event_reset(ethr_event *e) } static ETHR_INLINE int -wait(ethr_event *e, int spincount) +wait(ethr_event *e, int spincount, ethr_sint64_t timeout) { - DWORD code; + DWORD code, tmo; int sc, res, until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + if (timeout < 0) + tmo = INFINITE; + else if (timeout == 0) { + ethr_sint32_t state = ethr_atomic32_read(&e->state); + if (state == ETHR_EVENT_ON__) { + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); + return 0; + } + return ETIMEDOUT; + } + else { + /* + * Timeout in nano-seconds, but we can only + * wait for milli-seconds... + */ + tmo = (DWORD) (timeout - 1) / (1000*1000) + 1; + } + if (spincount < 0) ETHR_FATAL_ERROR__(EINVAL); @@ -72,8 +97,10 @@ wait(ethr_event *e, int spincount) ethr_sint32_t state; while (1) { state = ethr_atomic32_read(&e->state); - if (state == ETHR_EVENT_ON__) + if (state == ETHR_EVENT_ON__) { + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); return 0; + } if (sc == 0) break; sc--; @@ -95,7 +122,9 @@ wait(ethr_event *e, int spincount) ETHR_ASSERT(state == ETHR_EVENT_OFF__); } - code = WaitForSingleObject(e->handle, INFINITE); + code = WaitForSingleObject(e->handle, tmo); + if (code == WAIT_TIMEOUT) + return ETIMEDOUT; if (code != WAIT_OBJECT_0) ETHR_FATAL_ERROR__(ethr_win_get_errno__()); } @@ -105,11 +134,23 @@ wait(ethr_event *e, int spincount) int ethr_event_wait(ethr_event *e) { - return wait(e, 0); + return wait(e, 0, -1); } int ethr_event_swait(ethr_event *e, int spincount) { - return wait(e, spincount); + return wait(e, spincount, -1); +} + +int +ethr_event_twait(ethr_event *e, ethr_sint64_t timeout) +{ + return wait(e, 0, timeout); +} + +int +ethr_event_stwait(ethr_event *e, int spincount, ethr_sint64_t timeout) +{ + return wait(e, spincount, timeout); } diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex c8ec111e57..df768f9ed6 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex d0f9907709..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 ba45e4e011..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 26f779500c..f3abb5c1c7 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 4d22d8bace..4af9d233b5 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex efc8347b6e..7c0b49235e 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 6c49b5185e..00babefbb4 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex f58ee4b4d5..6640a29c62 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 73be297bbb..3d6f1548d0 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 193cebdc31..3224546179 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 2e4331e15f..4ef4288ead 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -38,7 +38,6 @@ -export([integer_to_list/2]). -export([integer_to_binary/2]). --export([flush_monitor_message/2]). -export([set_cpu_topology/1, format_cpu_topology/1]). -export([await_proc_exit/3]). -export([memory/0, memory/1]). @@ -48,7 +47,7 @@ await_sched_wall_time_modifications/2, gather_gc_info_result/1]). --deprecated([hash/2]). +-deprecated([hash/2, now/0]). %% Get rid of autoimports of spawn to avoid clashes with ourselves. -compile({no_auto_import,[spawn_link/1]}). @@ -58,12 +57,21 @@ -compile({no_auto_import,[spawn_opt/5]}). -export_type([timestamp/0]). +-export_type([time_unit/0]). -type ext_binary() :: binary(). -type timestamp() :: {MegaSecs :: non_neg_integer(), Secs :: non_neg_integer(), MicroSecs :: non_neg_integer()}. +-type time_unit() :: + pos_integer() + | 'seconds' + | 'milli_seconds' + | 'micro_seconds' + | 'nano_seconds' + | 'native'. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types %% (BIF's actually implemented in this module goes last in the file) @@ -81,7 +89,7 @@ -export([binary_to_list/3, binary_to_term/1, binary_to_term/2]). -export([bit_size/1, bitsize/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). --export([cancel_timer/1, check_old_code/1, check_process_code/2, +-export([cancel_timer/1, cancel_timer/2, check_old_code/1, check_process_code/2, check_process_code/3, crc32/1]). -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]). -export([delete_element/2]). @@ -104,7 +112,8 @@ -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). -export([list_to_integer/1, list_to_integer/2]). -export([list_to_pid/1, list_to_tuple/1, loaded/0]). --export([localtime/0, make_ref/0, map_size/1, match_spec_test/3, md5/1, md5_final/1]). +-export([localtime/0, make_ref/0]). +-export([map_size/1, match_spec_test/3, md5/1, md5_final/1]). -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]). -export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2]). -export([node/0, node/1, now/0, phash/2, phash2/1, phash2/2]). @@ -112,13 +121,19 @@ -export([port_connect/2, port_control/3, port_get_data/1]). -export([port_set_data/2, port_to_list/1, ports/0]). -export([posixtime_to_universaltime/1, pre_loaded/0, prepare_loading/2]). +-export([monotonic_time/0, monotonic_time/1]). +-export([system_time/0, system_time/1]). +-export([convert_time_unit/3]). +-export([unique_integer/0, unique_integer/1]). +-export([time_offset/0, time_offset/1, timestamp/0]). -export([process_display/2]). -export([process_flag/3, process_info/1, processes/0, purge_module/1]). --export([put/2, raise/3, read_timer/1, ref_to_list/1, register/2]). --export([registered/0, resume_process/1, round/1, self/0, send_after/3]). +-export([put/2, raise/3, read_timer/1, read_timer/2, ref_to_list/1, register/2]). +-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]). @@ -413,9 +428,20 @@ call_on_load_function(_P1) -> -spec erlang:cancel_timer(TimerRef) -> Time | false when TimerRef :: reference(), Time :: non_neg_integer(). + cancel_timer(_TimerRef) -> erlang:nif_error(undefined). +%% cancel_timer/2 +-spec erlang:cancel_timer(TimerRef, Options) -> Time | false | ok when + TimerRef :: reference(), + Option :: {async, boolean()} | {info, boolean()}, + Options :: [Option], + Time :: non_neg_integer(). + +cancel_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). + %% check_old_code/1 -spec check_old_code(Module) -> boolean() when Module :: module(). @@ -1190,13 +1216,18 @@ md5_update(_Context, _Data) -> module_loaded(_Module) -> erlang:nif_error(undefined). +-type registered_name() :: atom(). + +-type registered_process_identifier() :: registered_name() | {registered_name(), node()}. + +-type monitor_process_identifier() :: pid() | registered_process_identifier(). + %% monitor/2 --spec monitor(Type, Item) -> MonitorRef when - Type :: process, - Item :: pid() | RegName | {RegName, Node}, - RegName :: module(), - Node :: node(), +-spec monitor(process, monitor_process_identifier()) -> MonitorRef when + MonitorRef :: reference(); + (time_offset, clock_service) -> MonitorRef when MonitorRef :: reference(). + monitor(_Type, _Item) -> erlang:nif_error(undefined). @@ -1298,6 +1329,90 @@ ports() -> posixtime_to_universaltime(_P1) -> erlang:nif_error(undefined). +-spec erlang:unique_integer(ModifierList) -> integer() when + ModifierList :: [Modifier], + Modifier :: positive | monotonic. + +unique_integer(_ModifierList) -> + erlang:nif_error(undefined). + +-spec erlang:unique_integer() -> integer(). + +unique_integer() -> + erlang:nif_error(undefined). + +-spec erlang:monotonic_time() -> integer(). + +monotonic_time() -> + erlang:nif_error(undefined). + +-spec erlang:monotonic_time(Unit) -> integer() when + Unit :: time_unit(). + +monotonic_time(_Unit) -> + erlang:nif_error(undefined). + +-spec erlang:system_time() -> integer(). + +system_time() -> + erlang:nif_error(undefined). + +-spec erlang:system_time(Unit) -> integer() when + Unit :: time_unit(). + +system_time(_Unit) -> + erlang:nif_error(undefined). + +-spec erlang:convert_time_unit(Time, FromUnit, ToUnit) -> ConvertedTime when + Time :: integer(), + ConvertedTime :: integer(), + FromUnit :: time_unit(), + ToUnit :: time_unit(). + +convert_time_unit(Time, FromUnit, ToUnit) -> + try + FU = case FromUnit of + native -> erts_internal:time_unit(); + nano_seconds -> 1000*1000*1000; + micro_seconds -> 1000*1000; + milli_seconds -> 1000; + seconds -> 1; + _ when FromUnit > 0 -> FromUnit + end, + TU = case ToUnit of + native -> erts_internal:time_unit(); + nano_seconds -> 1000*1000*1000; + micro_seconds -> 1000*1000; + milli_seconds -> 1000; + seconds -> 1; + _ when ToUnit > 0 -> ToUnit + end, + case Time < 0 of + true -> TU*Time - (FU - 1); + false -> TU*Time + end div FU + catch + _ : _ -> + erlang:error(badarg, [Time, FromUnit, ToUnit]) + end. + +-spec erlang:time_offset() -> integer(). + +time_offset() -> + erlang:nif_error(undefined). + +-spec erlang:time_offset(Unit) -> integer() when + Unit :: time_unit(). + +time_offset(_Unit) -> + erlang:nif_error(undefined). + +-spec erlang:timestamp() -> Timestamp when + Timestamp :: timestamp(). + +timestamp() -> + erlang:nif_error(undefined). + %% prepare_loading/2 -spec erlang:prepare_loading(Module, Code) -> PreparedCode | {error, Reason} when Module :: module(), @@ -1365,9 +1480,19 @@ raise(_Class, _Reason, _Stacktrace) -> %% read_timer/1 -spec erlang:read_timer(TimerRef) -> non_neg_integer() | false when TimerRef :: reference(). + read_timer(_TimerRef) -> erlang:nif_error(undefined). +%% read_timer/2 +-spec erlang:read_timer(TimerRef, Options) -> non_neg_integer() | false | ok when + TimerRef :: reference(), + Option :: {async, boolean()}, + Options :: [Option]. + +read_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). + %% ref_to_list/1 -spec erlang:ref_to_list(Ref) -> string() when Ref :: reference(). @@ -1412,9 +1537,22 @@ self() -> Dest :: pid() | atom(), Msg :: term(), TimerRef :: reference(). + 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 P1 :: atom(), @@ -1486,9 +1624,22 @@ split_binary(_Bin, _Pos) -> Dest :: pid() | atom(), Msg :: term(), TimerRef :: reference(). + 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 Suspendee :: pid(), @@ -1657,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). @@ -2124,6 +2275,8 @@ subtract(_,_) -> (trace_control_word, TCW) -> OldTCW when TCW :: non_neg_integer(), OldTCW :: non_neg_integer(); + (time_offset, finalize) -> OldState when + OldState :: preliminary | final | volatile; %% These are deliberately not documented (internal_cpu_topology, term()) -> term(); (sequential_tracer, pid() | port() | false) -> pid() | port() | false; @@ -2260,6 +2413,8 @@ tuple_to_list(_Tuple) -> (multi_scheduling_blockers) -> [PID :: pid()]; (nif_version) -> string(); (otp_release) -> string(); + (os_monotonic_time_source) -> [{atom(),term()}]; + (os_system_time_source) -> [{atom(),term()}]; (port_count) -> non_neg_integer(); (port_limit) -> pos_integer(); (process_count) -> pos_integer(); @@ -2277,10 +2432,14 @@ tuple_to_list(_Tuple) -> (scheduler_id) -> SchedulerId :: pos_integer(); (schedulers | schedulers_online) -> pos_integer(); (smp_support) -> boolean(); + (start_time) -> integer(); (system_version) -> string(); (system_architecture) -> string(); (threads) -> boolean(); (thread_pool_size) -> non_neg_integer(); + (time_correction) -> true | false; + (time_offset) -> preliminary | final | volatile; + (time_warp_mode) -> no_time_warp | single_time_warp | multi_time_warp; (tolerant_timeofday) -> enabled | disabled; (trace_control_word) -> non_neg_integer(); (update_cpu_info) -> changed | unchanged; @@ -3047,16 +3206,6 @@ integer_to_binary(I0, Base, R0) -> true -> integer_to_binary(I1, Base, R1) end. -%% erlang:flush_monitor_message/2 is for internal use only! -%% -%% erlang:demonitor(Ref, [flush]) traps to -%% erlang:flush_monitor_message(Ref, Res) when -%% it needs to flush a monitor message. -flush_monitor_message(Ref, Res) when erlang:is_reference(Ref), - erlang:is_atom(Res) -> - receive {_, Ref, _, _, _} -> ok after 0 -> ok end, - Res. - -record(cpu, {node = -1, processor = -1, processor_node = -1, diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 2c5bd82cf0..65a1f1ed3a 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -30,7 +30,7 @@ -export([await_port_send_result/3]). -export([cmp_term/2]). --export([map_to_tuple_keys/1]). +-export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]). -export([port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). @@ -38,6 +38,14 @@ -export([check_process_code/2]). +-export([flush_monitor_messages/3]). + +-export([await_result/1]). + +-export([time_unit/0]). + +-export([is_system_process/1]). + %% %% Await result of send to port %% @@ -49,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 %% @@ -178,3 +196,52 @@ cmp_term(_A,_B) -> map_to_tuple_keys(_M) -> erlang:nif_error(undefined). + +%% return the internal map type +-spec map_type(M) -> Type when + M :: map(), + Type :: 'flatmap' | 'hashmap' | 'hashmap_node'. + +map_type(_M) -> + erlang:nif_error(undefined). + +%% return the internal hashmap sub-nodes from +%% a hashmap node +-spec map_hashmap_children(M) -> Children when + M :: map(), %% hashmap node + Children :: [map() | nonempty_improper_list(term(),term())]. + +map_hashmap_children(_M) -> + erlang:nif_error(undefined). + +-spec erts_internal:flush_monitor_messages(Ref, Multi, Res) -> term() when + Ref :: reference(), + Multi :: boolean(), + Res :: term(). + +%% erlang:demonitor(Ref, [flush]) traps to +%% erts_internal:flush_monitor_messages(Ref, Res) when +%% it needs to flush monitor messages. +flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) -> + receive + {_, Ref, _, _, _} -> + case Multi of + false -> + Res; + _ -> + flush_monitor_messages(Ref, Multi, Res) + end + after 0 -> + Res + end. + +-spec erts_internal:time_unit() -> pos_integer(). + +time_unit() -> + erlang:nif_error(undefined). + +-spec erts_internal:is_system_process(Pid) -> boolean() when + Pid :: pid(). + +is_system_process(_Pid) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index e95e11b3e6..bb56c9ff73 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -591,12 +591,9 @@ kill_all_pids(Heart) -> kill_all_pids(Heart) % Continue until all are really killed. end. -%% All except zombies. -alive_processes() -> - [P || P <- processes(), erlang:is_process_alive(P)]. - +%% All except system processes. get_pids(Heart) -> - Pids = alive_processes(), + Pids = [P || P <- processes(), not erts_internal:is_system_process(P)], delete(Heart,self(),Pids). delete(Heart,Init,[Heart|Pids]) -> delete(Heart,Init,Pids); diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index df7b2e6198..5d9f90ec58 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -24,13 +24,14 @@ deflate/2,deflate/3,deflateEnd/1, inflateInit/1,inflateInit/2,inflateSetDictionary/2, inflateSync/1,inflateReset/1,inflate/2,inflateEnd/1, + inflateChunk/1, inflateChunk/2, setBufSize/2,getBufSize/1, crc32/1,crc32/2,crc32/3,adler32/2,adler32/3,getQSize/1, crc32_combine/4,adler32_combine/4, compress/1,uncompress/1,zip/1,unzip/1, gzip/1,gunzip/1]). --export_type([zstream/0]). +-export_type([zstream/0, zlevel/0, zwindowbits/0, zmemlevel/0, zstrategy/0]). %% flush argument encoding -define(Z_NO_FLUSH, 0). @@ -100,6 +101,7 @@ -define(INFLATE_RESET, 12). -define(INFLATE_END, 13). -define(INFLATE, 14). +-define(INFLATE_CHUNK, 25). -define(CRC32_0, 15). -define(CRC32_1, 16). @@ -124,7 +126,7 @@ -type zlevel() :: 'none' | 'default' | 'best_compression' | 'best_speed' | 0..9. -type zmethod() :: 'deflated'. --type zwindowbits() :: -15..-9 | 9..47. +-type zwindowbits() :: -15..-8 | 8..47. -type zmemlevel() :: 1..9. -type zstrategy() :: 'default' | 'filtered' | 'huffman_only' | 'rle'. @@ -263,6 +265,39 @@ inflate(Z, Data) -> erlang:error(badarg) end. +-spec inflateChunk(Z, Data) -> Decompressed | {more, Decompressed} when + Z :: zstream(), + Data :: iodata(), + Decompressed :: iolist(). +inflateChunk(Z, Data) -> + try port_command(Z, Data) of + true -> + inflateChunk(Z) + catch + error:_Err -> + flush(Z), + erlang:error(badarg) + end. + +-spec inflateChunk(Z) -> Decompressed | {more, Decompressed} when + Z :: zstream(), + Decompressed :: iolist(). +inflateChunk(Z) -> + Status = call(Z, ?INFLATE_CHUNK, []), + Data = receive + {Z, {data, Bin}} -> + Bin + after 0 -> + [] + end, + + case Status of + Good when (Good == ok) orelse (Good == stream_end) -> + Data; + inflate_has_more -> + {more, Data} + end. + -spec inflateEnd(Z) -> 'ok' when Z :: zstream(). inflateEnd(Z) -> @@ -496,8 +531,8 @@ arg_method(_) -> erlang:error(badarg). -spec arg_bitsz(zwindowbits()) -> zwindowbits(). arg_bitsz(Bits) when is_integer(Bits) andalso - ((8 < Bits andalso Bits < 48) orelse - (-15 =< Bits andalso Bits < -8)) -> + ((8 =< Bits andalso Bits < 48) orelse + (-15 =< Bits andalso Bits =< -8)) -> Bits; arg_bitsz(_) -> erlang:error(badarg). @@ -514,7 +549,9 @@ call(Z, Cmd, Arg) -> [2,A,B,C,D] -> (A bsl 24)+(B bsl 16)+(C bsl 8)+D; [3,A,B,C,D] -> - erlang:error({need_dictionary,(A bsl 24)+(B bsl 16)+(C bsl 8)+D}) + erlang:error({need_dictionary,(A bsl 24)+(B bsl 16)+(C bsl 8)+D}); + [4, _, _, _, _] -> + inflate_has_more catch error:badarg -> %% Rethrow loses port_control from stacktrace. erlang:error(badarg) 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/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 229d10ccee..c416e031c2 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.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 @@ -23,7 +23,7 @@ init_per_suite/1,end_per_suite/1]). -export([undefined_functions/1,deprecated_not_in_obsolete/1, obsolete_but_not_deprecated/1,call_to_deprecated/1, - call_to_size_1/1,strong_components/1, + call_to_size_1/1,call_to_now_0/1,strong_components/1, erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [undefined_functions, deprecated_not_in_obsolete, obsolete_but_not_deprecated, call_to_deprecated, - call_to_size_1, strong_components, + call_to_size_1, call_to_now_0, strong_components, erl_file_encoding, xml_file_encoding, runtime_dependencies]. @@ -94,7 +94,8 @@ undefined_functions(Config) when is_list(Config) -> Undef4 = eunit_filter(Undef3), Undef5 = dialyzer_filter(Undef4), Undef6 = wx_filter(Undef5), - Undef = gs_filter(Undef6), + Undef7 = gs_filter(Undef6), + Undef = diameter_filter(Undef7), case Undef of [] -> ok; @@ -217,6 +218,19 @@ gs_filter(Undef) -> _ -> Undef end. +diameter_filter(Undef) -> + %% Filter away function calls that are catched. + filter(fun({{diameter_lib,_,_},{erlang,convert_time_unit,3}}) -> + false; + ({{diameter_lib,_,_},{erlang,monotonic_time,0}}) -> + false; + ({{diameter_lib,_,_},{erlang,unique_integer,0}}) -> + false; + ({{diameter_lib,_,_},{erlang,time_offset,0}}) -> + false; + (_) -> true + end, Undef). + deprecated_not_in_obsolete(Config) when is_list(Config) -> ?line Server = ?config(xref_server, Config), ?line {ok,DeprecatedFunctions} = xref:q(Server, "DF"), @@ -273,48 +287,58 @@ call_to_deprecated(Config) when is_list(Config) -> {comment,integer_to_list(length(DeprecatedCalls))++" calls to deprecated functions"}. call_to_size_1(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), - %% Applications that do not call erlang:size/1: Apps = [asn1,compiler,debugger,kernel,observer,parsetools, runtime_tools,stdlib,tools,webtool], + not_recommended_calls(Config, Apps, {erlang,size,1}). + +call_to_now_0(Config) when is_list(Config) -> + %% Applications that do not call erlang:now/1: + Apps = [asn1,common_test,compiler,debugger,dialyzer, + gs,kernel,mnesia,observer,parsetools,reltool, + runtime_tools,sasl,stdlib,syntax_tools, + test_server,tools,webtool], + not_recommended_calls(Config, Apps, {erlang,now,0}). + +not_recommended_calls(Config, Apps, MFA) -> + Server = ?config(xref_server, Config), - Fs = [{erlang,size,1}], + Fs = [MFA], Q1 = io_lib:format("E || ~p : Fun", [Fs]), - ?line {ok,AllCallsToSize1} = xref:q(Server, lists:flatten(Q1)), + {ok,AllCallsToMFA} = xref:q(Server, lists:flatten(Q1)), Q2 = io_lib:format("E | ~p : App || ~p : Fun", [Apps,Fs]), - ?line {ok,CallsToSize1} = xref:q(Server, lists:flatten(Q2)), + {ok,CallsToMFA} = xref:q(Server, lists:flatten(Q2)), - case CallsToSize1 of + case CallsToMFA of [] -> ok; _ -> - io:format("These calls cause an error:~n"), + io:format("These calls are not allowed:\n"), foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls soon to be deprecated ~s", + io:format("~s calls non-recommended ~s", [format_mfa(MFA1),format_mfa(MFA2)]) - end, CallsToSize1) + end, CallsToMFA) end, - %% Enumerate calls to erlang:size/1 from other applications than - %% the ones known not to call erlang:size/1: - case AllCallsToSize1--CallsToSize1 of + %% Enumerate calls to MFA from other applications than + %% the ones known not to call MFA: + case AllCallsToMFA--CallsToMFA of [] -> ok; Calls -> - io:format("~n~nThese calls do not cause an error (yet):~n"), + io:format("~n~nThese calls are allowed for now:\n"), foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls soon to be deprecated ~s", + io:format("~s calls non-recommended ~s", [format_mfa(MFA1),format_mfa(MFA2)]) end, Calls) end, - case CallsToSize1 of + case CallsToMFA of [] -> ok; _ -> - ?line ?t:fail({length(CallsToSize1),calls_to_size_1}) + ?t:fail({length(CallsToMFA),calls_to_size_1}) end. strong_components(Config) when is_list(Config) -> |