diff options
Diffstat (limited to 'erts')
274 files changed, 31792 insertions, 8790 deletions
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 5735cdea5c..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)]) @@ -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([ @@ -1349,56 +1866,62 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) - fi - - 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 + pthread_setname=no + AC_MSG_CHECKING([for pthread_setname_np]) + old_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS -Werror" + AC_TRY_LINK([#define __USE_GNU + #include <pthread.h>], + [pthread_setname_np(pthread_self(), "name");], + pthread_setname=linux) + AC_TRY_LINK([#define __USE_GNU + #include <pthread.h>], + [pthread_set_name_np(pthread_self(), "name");], + pthread_setname=bsd) + AC_TRY_LINK([#define _DARWIN_C_SOURCE + #include <pthread.h>], + [pthread_setname_np("name");], + pthread_setname=darwin) + AC_MSG_RESULT([$pthread_setname]) + case $pthread_setname in + linux) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_2, 1, + [Define if you have linux style pthread_setname_np]);; + bsd) AC_DEFINE(ETHR_HAVE_PTHREAD_SET_NAME_NP_2, 1, + [Define if you have bsd style pthread_set_name_np]);; + darwin) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_1, 1, + [Define if you have darwin style pthread_setname_np]);; + *) ;; + esac - 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 + pthread_getname=no + AC_MSG_CHECKING([for pthread_getname_np]) + AC_TRY_LINK([#define __USE_GNU + #define _DARWIN_C_SOURCE + #include <pthread.h>], + [char buff[256]; pthread_getname_np(pthread_self(), buff, 256);], + pthread_getname=normal) + AC_TRY_LINK([#define __USE_GNU + #define _DARWIN_C_SOURCE + #include <pthread.h>], + [char buff[256]; pthread_getname_np(pthread_self(), buff);], + pthread_getname=ibm) + AC_MSG_RESULT([$pthread_getname]) + case $pthread_getname in + linux) AC_DEFINE(ETHR_HAVE_PTHREAD_GETNAME_NP_3, 1, + [Define if you have linux style pthread_getname_np]);; + ibm) AC_DEFINE(ETHR_HAVE_PTHREAD_GETNAME_NP_2, 1, + [Define if you have ibm style pthread_getname_np]);; + *) ;; + esac + CFLAGS=$old_CFLAGS - int128=no - if test "$ac_cv_sizeof___int128_t" = "16"; then - int128="__int128_t" - fi + fi ## test "x$THR_LIB_NAME" = "xpthread" 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 @@ -1448,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 @@ -1479,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;; *) ;; @@ -1660,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 + +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 -]) -xrtlib="" -case $erl_cv_time_correction in +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. @@ -1835,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], @@ -1881,43 +2500,33 @@ case $erl_gethrvtime in exit(0); return 0; } ], - erl_clock_gettime=yes, - erl_clock_gettime=no, + erl_clock_gettime_cpu_time=yes, + erl_clock_gettime_cpu_time=no, [ case X$erl_xcomp_clock_gettime_cpu_time in - X) erl_clock_gettime=cross;; - Xyes|Xno) erl_clock_gettime=$erl_xcomp_clock_gettime_cpu_time;; + X) erl_clock_gettime_cpu_time=cross;; + Xyes|Xno) erl_clock_gettime_cpu_time=$erl_xcomp_clock_gettime_cpu_time;; *) AC_MSG_ERROR([Bad erl_xcomp_clock_gettime_cpu_time value: $erl_xcomp_clock_gettime_cpu_time]);; esac ]) LIBS=$save_libs - case $host_os in - linux*) - AC_MSG_RESULT([no; not stable]) - LIBRT=$xrtlib + AC_MSG_RESULT($erl_clock_gettime_cpu_time) + case $erl_clock_gettime_cpu_time in + yes) + AC_DEFINE(HAVE_CLOCK_GETTIME_CPU_TIME,[], + [define if clock_gettime() works for getting process time]) + LIBRT=-lrt + ;; + cross) + erl_clock_gettime_cpu_time=no + AC_MSG_WARN([result no guessed because of cross compilation]) ;; *) - AC_MSG_RESULT($erl_clock_gettime) - case $erl_clock_gettime in - yes) - AC_DEFINE(HAVE_CLOCK_GETTIME,[], - [define if clock_gettime() works for getting process time]) - LIBRT=-lrt - ;; - cross) - erl_clock_gettime=no - AC_MSG_WARN([result no guessed because of cross compilation]) - LIBRT=$xrtlib - ;; - *) - LIBRT=$xrtlib - ;; - esac ;; 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/vxworks/sed.general b/erts/autoconf/vxworks/sed.general index efa4e99054..c82b7348cf 100644 --- a/erts/autoconf/vxworks/sed.general +++ b/erts/autoconf/vxworks/sed.general @@ -78,8 +78,6 @@ s|@WITH_SCTP@|| # HiPE s|@HIPE_ENABLED@|| -s|@PERFCTR_PATH@|| -s|@USE_PERFCTR@|| # m4 s|@OPSYS@|noopsys| 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 b3fe48d62c..ce0cef871f 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 @@ -264,24 +264,6 @@ AS_HELP_STRING([--enable-m32-build], esac ],enable_m32_build=no) -AC_SUBST(PERFCTR_PATH) -AC_ARG_WITH(perfctr, -AS_HELP_STRING([--with-perfctr=PATH], - [specify location of perfctr include and lib]) -AS_HELP_STRING([--without-perfctr], [don't use perfctr (default)])) - -if test "x$with_perfctr" = "xno" -o "x$with_perfctr" = "x" ; then - PERFCTR_PATH= -else - if test ! -f "$with_perfctr/usr.lib/libperfctr.a" ; then - AC_MSG_ERROR(Invalid path to option --with-perfctr=PATH) - fi - PERFCTR_PATH="$with_perfctr" - AC_DEFINE(USE_PERFCTR,[1], - [Define to enable hrvtime() on Linux systems with perfctr extension]) -fi - - AC_ARG_WITH(dynamic-trace, AS_HELP_STRING([--with-dynamic-trace={dtrace|systemtap}], [specify use of dynamic trace framework, dtrace or systemtap]) @@ -335,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)])) @@ -649,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 @@ -676,6 +649,7 @@ case $chk_arch_ in powerpc) ARCH=ppc;; ppc) ARCH=ppc;; ppc64) ARCH=ppc64;; + ppc64le) ARCH=ppc64;; "Power Macintosh") ARCH=ppc;; armv5b) ARCH=arm;; armv5teb) ARCH=arm;; @@ -1123,10 +1097,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) @@ -1555,10 +1550,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])) ;; @@ -1765,6 +1761,10 @@ AC_CHECK_HEADER(sys/event.h, have_kernel_poll=kqueue) AC_CHECK_HEADER(sys/epoll.h, have_kernel_poll=epoll) AC_CHECK_HEADER(sys/devpoll.h, have_kernel_poll=/dev/poll) +dnl Check if we have timerfds to be used for high accuracy +dnl epoll_wait timeouts +AC_CHECK_HEADERS([sys/timerfd.h]) + dnl Check for kernel SCTP support AC_SUBST(LIBSCTP) if test "x$enable_sctp" != "xno" ; then @@ -2110,7 +2110,7 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop gethrtime localtime_r gmtime_r inet_pton \ memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ - setlocale nl_langinfo poll mlockall]) + setlocale nl_langinfo poll mlockall ppoll]) AC_MSG_CHECKING([for isfinite]) AC_TRY_LINK([#include <math.h>], @@ -2913,6 +2913,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; /* @@ -3503,19 +3507,6 @@ fi AC_SUBST(NATIVE_LIBS_ENABLED) # -# Check if HiPE should use a standard installation of perfctr. -# -AC_SUBST(USE_PERFCTR) -if test "x$HIPE_ENABLED" = "xyes" ; then - if test "x$with_perfctr" = "x" ; then - AC_CHECK_LIB(perfctr, vperfctr_info, [USE_PERFCTR=1 - AC_DEFINE(USE_PERFCTR,[1],[Define to enable hrvtime() on Linux systems with perfctr extension])]) - elif test "x$with_perfctr" != "xno" ; then - USE_PERFCTR=1 - fi -fi - -# # Check for working poll(). # AC_MSG_CHECKING([for working poll()]) @@ -4303,10 +4294,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 @@ -4501,10 +4492,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]) @@ -4701,18 +4692,32 @@ 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 ;; + freebsd*) + 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)]) @@ -4743,12 +4748,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 @@ -4905,6 +4910,11 @@ LDFLAGS="$LDFLAGS $sanitizers" ]) dnl ---------------------------------------------------------------------- +dnl Check for log2 +dnl ---------------------------------------------------------------------- +AC_CHECK_FUNCS([log2]) + +dnl ---------------------------------------------------------------------- dnl Output the result. dnl ---------------------------------------------------------------------- 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/crash_dump.xml b/erts/doc/src/crash_dump.xml index 2b5fc877c3..8291bf38b7 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -55,10 +55,12 @@ emulator or the operating system can be reconfigured to avoid the crash, which is why interpreting the crash dump correctly is important.</p> + <p>On systems that support OS signals, it is also possible to stop + the runtime system and generate a crash dump by sending the SIGUSR1.</p> <p>The erlang crash dump is a readable text file, but it might not be very easy to read. Using the Crashdump Viewer tool in the <c><![CDATA[observer]]></c> application will simplify the task. This is an - HTML based tool for browsing Erlang crash dumps.</p> + wx-widget based tool for browsing Erlang crash dumps.</p> <section> <marker id="general_info"></marker> @@ -66,8 +68,9 @@ <p>The first part of the dump shows the creation time for the dump, a slogan indicating the reason for the dump, the system version, of the node from which the dump originates, the compile time of - the emulator running the originating node and the number of - atoms in the atom table. + the emulator running the originating node, the number of + atoms in the atom table and the runtime system thread that caused + the crash dump to happen. </p> <section> @@ -170,6 +173,60 @@ </section> <section> + <marker id="scheduler"></marker> + <title>Scheduler information</title> + <p>Under the tag <em>=scheduler</em> information about the current state + and statistics of the schedulers in the runtime system is displayed. + On OSs that do allow instant suspension of other threads, the data within + this section will reflect what the runtime system looks like at the moment + when the crash happens.</p> + <p>The following fields can exist for a process:</p> + <taglist> + <tag><em>=scheduler:id</em></tag> + <item>Header, states the scheduler identifier.</item> + <tag><em>Scheduler Sleep Info Flags</em></tag> + <item>If empty the scheduler was doing some work. + If not empty the scheduler is either in some state of sleep, + or suspended. This entry is only present in a SMP enabled emulator</item> + <tag><em>Scheduler Sleep Info Aux Work</em></tag> + <item>If not empty, a scheduler internal auxiliary work is scheduled + to be done.</item> + <tag><em>Current Port</em></tag> + <item>The port identifier of the port that is currently being + executed by the scheduler.</item> + <tag><em>Current Process</em></tag> + <item>The process identifier of the process that is currently being + executed by the scheduler. If there is such a process this entry is + followed by the <em>State</em>,<em>Internal State</em>, + <em>Program Counter</em>, <em>CP</em> of that same process. See + <seealso marker="#processes">Process Information</seealso> for a + description what the different entries mean. Keep in mind that + this is a snapshot of what the entries are exactly when the crash + dump is starting to be generated. Therefore they will most likely + be different (and more telling) then the entries for the same + processes found in the <em>=proc</em> section. If there is no currently + running process, only the <em>Current Process</em> entry will be printed. + </item> + <tag><em>Current Process Limited Stack Trace</em></tag> + <item>This entry only shows up if there is a current process. It is very + similar to <seealso marker="#proc_data"><em>=proc_stack</em></seealso>, + except that only the function frames are printed (i.e. the stack variables + are omited). It is also limited to only print the top and bottom part + of the stack. If the stack is small (less that 512 slots) then the + entire stack will be printed. If not, an entry stating + <code>skipping ## slots</code> will be printed where ## is + replaced by the number of slots that has been skipped.</item> + <tag><em>Run Queue</em></tag> + <item>Displays statistics about how many processes and ports + of different priorities are scheduled on this scheduler.</item> + <tag><em>** crashed **</em></tag> + <item>This entry is normally not printed. It signifies that getting + the rest of the information about this scheduler failed for some reason. + </item> + </taglist> + </section> + + <section> <marker id="memory"></marker> <title>Memory information</title> <p>Under the tag <em>=memory</em> you will find information similar @@ -314,6 +371,9 @@ <item>The number of live argument registers. The argument registers, if any are live, will follow. These may contain the arguments of the function if they are not yet moved to the stack.</item> + <item><em>Internal State</em></item> + <item>A more detailed internal represantation of the state of + this process.</item> </taglist> <p>See also the section about <seealso marker="#proc_data">process data</seealso>.</p> </section> @@ -339,18 +399,38 @@ <tag><em>Name</em></tag> <item>The name of the table, regardless of whether it is a <c><![CDATA[named_table]]></c> or not.</item> - <tag><em>Buckets</em></tag> + <tag><em>Hash table, Buckets</em></tag> <item>This occurs if the table is a hash table, i.e. if it is not an <c><![CDATA[ordered_set]]></c>.</item> + <tag><em>Hash table, Chain Length</em></tag> + <item>Only applicable for hash tables. Contains statistics about the + hash table, such as the max, min and avg chain length. Having a max much + larger than the avg, and a std dev much larger that + the expected std dev is a sign that the hashing of the terms is + behaving badly for some reason.</item> <tag><em>Ordered set (AVL tree), Elements</em></tag> <item>This occurs only if the table is an <c><![CDATA[ordered_set]]></c>. (The number of elements is the same as the number of objects in the table.)</item> + <tag><em>Fixed</em></tag> + <item>If the table is fixed using ets:safe_fixtable or some internal + mechanism.</item> <tag><em>Objects</em></tag> <item>The number of objects in the table</item> <tag><em>Words</em></tag> <item>The number of words (usually 4 bytes/word) allocated to data in the table.</item> + <tag><em>Type</em></tag> + <item>The type of the table, i.e. <c>set</c>, <c>bag</c>, + <c>dublicate_bag</c> or <c>ordered_set</c>.</item> + <tag><em>Compressed</em></tag> + <item>If this table was compressed.</item> + <tag><em>Protection</em></tag> + <item>The protection of this table.</item> + <tag><em>Write Concurrency</em></tag> + <item>If write_concurrency was enabled for this table.</item> + <tag><em>Read Concurrency</em></tag> + <item>If read_concurrency was enabled for this table.</item> </taglist> </section> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f08467bfc6..98d05dc7de 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> @@ -1150,9 +1161,9 @@ <tag><marker id="+secio"><c>+secio true|false</c></marker></tag> <item> <p>Enable or disable eager check I/O scheduling. The default - is currently <c>false</c>, but will most likely be changed - to <c>true</c> in OTP 18. The behaviour before this flag - was introduced corresponds to <c>+secio false</c>.</p> + is currently <c>true</c>. The default was changed from <c>false</c> + to <c>true</c> as of erts version 7.0. The behaviour before this + flag was introduced corresponds to <c>+secio false</c>.</p> <p>The flag effects when schedulers will check for I/O operations possible to execute, and when such I/O operations will execute. As the name of the parameter implies, @@ -1311,13 +1322,14 @@ <item> <p>Verbose.</p> </item> - <tag><c><![CDATA[+W w | i]]></c></tag> + <tag><c><![CDATA[+W w | i | e]]></c></tag> <item> <p>Sets the mapping of warning messages for <c><![CDATA[error_logger]]></c>. Messages sent to the error logger using one of the warning - routines can be mapped either to errors (default), warnings - (<c><![CDATA[+W w]]></c>), or info reports (<c><![CDATA[+W i]]></c>). The current - mapping can be retrieved using + routines can be mapped either to errors (<c><![CDATA[+W e]]></c>), + warnings (<c><![CDATA[+W w]]></c>), or info reports + (<c><![CDATA[+W i]]></c>). The default is warnings. + The current mapping can be retrieved using <c><![CDATA[error_logger:warning_map/0]]></c>. See <seealso marker="kernel:error_logger#warning_map/0">error_logger(3)</seealso> for further information.</p> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 3de94be9ff..f64381c99d 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"> @@ -489,8 +461,9 @@ ok independent environment with all its terms is valid until you explicitly invalidates it with <seealso marker="#enif_free_env">enif_free_env</seealso> or <c>enif_send</c>.</p> - <p>All elements of a list/tuple must belong to the same environment as the - list/tuple itself. Terms can be copied between environments with + <p>All contained terms of a list/tuple/map must belong to the same + environment as the list/tuple/map itself. Terms can be copied between + environments with <seealso marker="#enif_make_copy">enif_make_copy</seealso>.</p> </item> <tag><marker id="ErlNifFunc"/>ErlNifFunc</tag> @@ -592,11 +565,11 @@ typedef enum { <funcs> <func><name><ret>void *</ret><nametext>enif_alloc(size_t size)</nametext></name> - <fsummary>Allocate dynamic memory.</fsummary> + <fsummary>Allocate dynamic memory</fsummary> <desc><p>Allocate memory of <c>size</c> bytes. Return NULL if allocation failed.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_alloc_binary(size_t size, ErlNifBinary* bin)</nametext></name> - <fsummary>Create a new binary.</fsummary> + <fsummary>Create a new binary</fsummary> <desc><p>Allocate a new binary of size <c>size</c> bytes. Initialize the structure pointed to by <c>bin</c> to refer to the allocated binary. The binary must either be released by @@ -623,7 +596,7 @@ typedef enum { <desc><p>Allocate a memory managed resource object of type <c>type</c> and size <c>size</c> bytes.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_clear_env(ErlNifEnv* env)</nametext></name> - <fsummary>Clear an environment for reuse.</fsummary> + <fsummary>Clear an environment for reuse</fsummary> <desc><p>Free all terms in an environment and clear it for reuse. The environment must have been allocated with <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>. </p></desc> @@ -711,14 +684,14 @@ typedef enum { <c>size-1</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_atom_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len, ErlNifCharEncoding encode)</nametext></name> - <fsummary>Get the length of atom <c>term</c>.</fsummary> + <fsummary>Get the length of atom <c>term</c></fsummary> <desc><p>Set <c>*len</c> to the length (number of bytes excluding terminating null character) of the atom <c>term</c> with encoding <c>encode</c>. Return true on success or false if <c>term</c> is not an atom.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_double(ErlNifEnv* env, ERL_NIF_TERM term, double* dp)</nametext></name> - <fsummary>Read a floating-point number term.</fsummary> + <fsummary>Read a floating-point number term</fsummary> <desc><p>Set <c>*dp</c> to the floating point value of <c>term</c>. Return true on success or false if <c>term</c> is not a float.</p></desc> </func> @@ -747,17 +720,28 @@ typedef enum { non-empty list.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_list_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)</nametext></name> - <fsummary>Get the length of list <c>term</c>.</fsummary> + <fsummary>Get the length of list <c>term</c></fsummary> <desc><p>Set <c>*len</c> to the length of list <c>term</c> and return true, or return false if <c>term</c> is not a list.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_long(ErlNifEnv* env, ERL_NIF_TERM term, long int* ip)</nametext></name> - <fsummary>Read an long integer term.</fsummary> + <fsummary>Read an long integer term</fsummary> <desc><p>Set <c>*ip</c> to the long integer value of <c>term</c> and return true, or return false if <c>term</c> is not an integer or is outside the bounds of type <c>long int</c>.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)</nametext></name> + <func><name><ret>int</ret><nametext>enif_get_map_size(ErlNifEnv* env, ERL_NIF_TERM term, size_t *size)</nametext></name> + <fsummary>Read the size of a map term</fsummary> + <desc><p>Set <c>*size</c> to the number of key-value pairs in the map <c>term</c> and + return true, or return false if <c>term</c> is not a map.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_get_map_value(ErlNifEnv* env, ERL_NIF_TERM map, ERL_NIF_TERM key, ERL_NIF_TERM* value)</nametext></name> + <fsummary>Get the value of a key in a map</fsummary> + <desc><p>Set <c>*value</c> to the value associated with <c>key</c> in the + map <c>map</c> and return true. Return false if <c>map</c> is not a map + or if <c>map</c> does not contain <c>key</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)</nametext></name> <fsummary>Get the pointer to a resource object</fsummary> <desc><p>Set <c>*objp</c> to point to the resource object referred to by <c>term</c>.</p> <p>Return true on success or false if <c>term</c> is not a handle to a resource object @@ -766,7 +750,7 @@ typedef enum { <func><name><ret>int</ret><nametext>enif_get_string(ErlNifEnv* env, ERL_NIF_TERM list, char* buf, unsigned size, ErlNifCharEncoding encode)</nametext></name> - <fsummary>Get a C-string from a list.</fsummary> + <fsummary>Get a C-string from a list</fsummary> <desc><p>Write a null-terminated string, in the buffer pointed to by <c>buf</c> with size <c>size</c>, consisting of the characters in the string <c>list</c>. The characters are written using encoding @@ -779,7 +763,7 @@ typedef enum { <c>size</c> is less than 1.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_tuple(ErlNifEnv* env, ERL_NIF_TERM term, int* arity, const ERL_NIF_TERM** array)</nametext></name> - <fsummary>Inspect the elements of a tuple.</fsummary> + <fsummary>Inspect the elements of a tuple</fsummary> <desc><p>If <c>term</c> is a tuple, set <c>*array</c> to point to an array containing the elements of the tuple and set <c>*arity</c> to the number of elements. Note that the array @@ -789,23 +773,36 @@ typedef enum { tuple.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_uint(ErlNifEnv* env, ERL_NIF_TERM term, unsigned int* ip)</nametext></name> - <fsummary>Read an unsigned integer term.</fsummary> + <fsummary>Read an unsigned integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned integer value of <c>term</c> and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned int</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_uint64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifUInt64* ip)</nametext></name> - <fsummary>Read an unsigned 64-bit integer term.</fsummary> + <fsummary>Read an unsigned 64-bit integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned integer value of <c>term</c> and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of an unsigned 64-bit integer.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_ulong(ErlNifEnv* env, ERL_NIF_TERM term, unsigned long* ip)</nametext></name> - <fsummary>Read an unsigned integer term.</fsummary> + <fsummary>Read an unsigned integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned long integer value of <c>term</c> 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, ERL_NIF_TERM* reason)</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>. If <c>reason</c> is a null pointer, ignore it. + Otherwise, if there's a pending exception associated with <c>env</c>, set the ERL_NIF_TERM + to which <c>reason</c> points to the value of the exception's term. For example, if + <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> is called to set a + pending <c>badarg</c> exception, a subsequent call to <c>enif_has_pending_exception(env, &reason)</c> + will set <c>reason</c> to the atom <c>badarg</c>, then return true.</p> + <p>See also: <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> + and <seealso marker="#enif_raise_exception">enif_raise_exception</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 @@ -839,6 +836,10 @@ typedef enum { <fsummary>Determine if a term is an exception</fsummary> <desc><p>Return true if <c>term</c> is an exception.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> + <fsummary>Determine if a term is a map</fsummary> + <desc><p>Return true if <c>term</c> is a map, false otherwise.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a number (integer or float)</fsummary> <desc><p>Return true if <c>term</c> is a number.</p></desc> @@ -898,40 +899,58 @@ 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> + <fsummary>Make a badarg exception</fsummary> + <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 be used only as the + return value from the NIF that invoked it (directly 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> + and <seealso marker="#enif_raise_exception">enif_raise_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> + <fsummary>Make a binary term</fsummary> <desc><p>Make a binary term from <c>bin</c>. Any ownership of the binary data will be transferred to the created term and <c>bin</c> should be considered read-only for the rest of the NIF call and then as released.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)</nametext></name> - <fsummary>Make a copy of a term.</fsummary> + <fsummary>Make a copy of a term</fsummary> <desc><p>Make a copy of term <c>src_term</c>. The copy will be created in environment <c>dst_env</c>. The source term may be located in any environment.</p></desc> </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 +958,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 +968,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> @@ -958,7 +981,7 @@ typedef enum { <desc><p>Create an integer term from a signed 64-bit integer.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list(ErlNifEnv* env, unsigned cnt, ...)</nametext></name> - <fsummary>Create a list term.</fsummary> + <fsummary>Create a list term</fsummary> <desc><p>Create an ordinary list term of length <c>cnt</c>. Expects <c>cnt</c> number of arguments (after <c>cnt</c>) of type ERL_NIF_TERM as the elements of the list. An empty list is returned if <c>cnt</c> is 0.</p></desc> @@ -972,28 +995,21 @@ typedef enum { <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list7(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e7)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list8(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e8)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list9(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e9)</nametext></name> - <fsummary>Create a list term.</fsummary> + <fsummary>Create a list term</fsummary> <desc><p>Create an ordinary list term with length indicated by the function name. Prefer these functions (macros) over the variadic <c>enif_make_list</c> to get a compile time error if the number of arguments does not match.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list_cell(ErlNifEnv* env, ERL_NIF_TERM head, ERL_NIF_TERM tail)</nametext></name> - <fsummary>Create a list cell.</fsummary> + <fsummary>Create a list cell</fsummary> <desc><p>Create a list cell <c>[head | tail]</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)</nametext></name> - <fsummary>Create a list term from an array.</fsummary> + <fsummary>Create a list term from an array</fsummary> <desc><p>Create an ordinary list containing the elements of array <c>arr</c> of length <c>cnt</c>. An empty list is returned if <c>cnt</c> is 0.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list)</nametext></name> - <fsummary>Create the reverse list of the list <c>term</c>.</fsummary> - <desc><p>Set <c>*list</c> to the reverse list of the list <c>term</c> and return true, - or return false if <c>term</c> is not a list. This function should only be used on - short lists as a copy will be created of the list which will not be released until after the - nif returns.</p></desc> - </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_long(ErlNifEnv* env, long int i)</nametext></name> <fsummary>Create an integer term from a long int</fsummary> <desc><p>Create an integer term from a <c>long int</c>.</p></desc> @@ -1008,12 +1024,42 @@ typedef enum { reallocated.</p><p>Return a pointer to the raw binary data and set <c>*termp</c> to the binary term.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_new_map(ErlNifEnv* env)</nametext></name> + <fsummary>Make an empty map term</fsummary> + <desc><p>Make an empty map term.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_put(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM value, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Insert key-value pair in map</fsummary> + <desc><p>Make a copy of map <c>map_in</c> and insert <c>key</c> with + <c>value</c>. If <c>key</c> already exists in <c>map_in</c>, the old + associated value is replaced by <c>value</c>. If successful set + <c>*map_out</c> to the new map and return true. Return false if + <c>map_in</c> is not a map.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_update(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM new_value, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Replace value for key in map</fsummary> + <desc><p>Make a copy of map <c>map_in</c> and replace the old associated + value for <c>key</c> with <c>new_value</c>. If successful set + <c>*map_out</c> to the new map and return true. Return false if + <c>map_in</c> is not a map or if it does no contain <c>key</c>.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_remove(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Remove key from map</fsummary> + <desc><p>If map <c>map_in</c> contains <c>key</c>, make a copy of + <c>map_in</c> in <c>*map_out</c> and remove <c>key</c> and associated + value. If map <c>map_in</c> does not contain <c>key</c>, set + <c>*map_out</c> to <c>map_in</c>. Return true for success or false if + <c>map_in</c> is not a map.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_pid(ErlNifEnv* env, const ErlNifPid* pid)</nametext></name> <fsummary>Make a pid term</fsummary> <desc><p>Make a pid term from <c>*pid</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_ref(ErlNifEnv* env)</nametext></name> - <fsummary>Create a reference.</fsummary> + <fsummary>Create a reference</fsummary> <desc><p>Create a reference like <seealso marker="erlang#make_ref-0">erlang:make_ref/0</seealso>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_resource(ErlNifEnv* env, void* obj)</nametext></name> @@ -1051,20 +1097,28 @@ typedef enum { <seealso marker="#enif_release_resource">enif_release_resource</seealso>.</p> </desc> </func> + <func><name><ret>int</ret><nametext>enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM list_in, ERL_NIF_TERM *list_out)</nametext></name> + <fsummary>Create the reverse of a list</fsummary> + <desc><p>Set <c>*list_out</c> to the reverse list of the list <c>list_in</c> and return true, + or return false if <c>list_in</c> is not a list. This function should only be used on + short lists as a copy will be created of the list which will not be released until after the + nif returns.</p> + <p>The <c>list_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_string(ErlNifEnv* env, const char* string, ErlNifCharEncoding encoding)</nametext></name> - <fsummary>Create a string.</fsummary> + <fsummary>Create a string</fsummary> <desc><p>Create a list containing the characters of the null-terminated string <c>string</c> with encoding <seealso marker="#ErlNifCharEncoding">encoding</seealso>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_string_len(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding encoding)</nametext></name> - <fsummary>Create a string.</fsummary> + <fsummary>Create a string</fsummary> <desc><p>Create a list containing the characters of the string <c>string</c> with length <c>len</c> and encoding <seealso marker="#ErlNifCharEncoding">encoding</seealso>. Null-characters are treated as any other characters.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, size_t pos, size_t size)</nametext></name> - <fsummary>Make a subbinary term.</fsummary> + <fsummary>Make a subbinary term</fsummary> <desc><p>Make a subbinary of binary <c>bin_term</c>, starting at zero-based position <c>pos</c> with a length of <c>size</c> bytes. <c>bin_term</c> must be a binary or bitstring and @@ -1072,7 +1126,7 @@ typedef enum { bytes in <c>bin_term</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)</nametext></name> - <fsummary>Create a tuple term.</fsummary> + <fsummary>Create a tuple term</fsummary> <desc><p>Create a tuple term of arity <c>cnt</c>. Expects <c>cnt</c> number of arguments (after <c>cnt</c>) of type ERL_NIF_TERM as the elements of the tuple.</p></desc> @@ -1086,14 +1140,14 @@ typedef enum { <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple7(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e7)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple8(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e8)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple9(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e9)</nametext></name> - <fsummary>Create a tuple term.</fsummary> + <fsummary>Create a tuple term</fsummary> <desc><p>Create a tuple term with length indicated by the function name. Prefer these functions (macros) over the variadic <c>enif_make_tuple</c> to get a compile time error if the number of arguments does not match.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)</nametext></name> - <fsummary>Create a tuple term from an array.</fsummary> + <fsummary>Create a tuple term from an array</fsummary> <desc><p>Create a tuple containing the elements of array <c>arr</c> of length <c>cnt</c>.</p></desc> </func> @@ -1109,6 +1163,72 @@ typedef enum { <fsummary>Create an integer term from an unsigned long int</fsummary> <desc><p>Create an integer term from an <c>unsigned long int</c>.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_create(ErlNifEnv *env, ERL_NIF_TERM map, ErlNifMapIterator *iter, ErlNifMapIteratorEntry entry)</nametext></name> + <fsummary>Create a map iterator</fsummary> + <desc><p>Create an iterator for the map <c>map</c> by initializing the + structure pointed to by <c>iter</c>. The <c>entry</c> argument determines + the start position of the iterator: <c>ERL_NIF_MAP_ITERATOR_FIRST</c> or + <c>ERL_NIF_MAP_ITERATOR_LAST</c>. Return true on success or false if + <c>map</c> is not a map.</p> + <p>A map iterator is only useful during the lifetime of the environment + <c>env</c> that the <c>map</c> belongs to. The iterator must be destroyed by + calling <seealso marker="#enif_map_iterator_destroy"> + enif_map_iterator_destroy</seealso>.</p> + <code type="none"> +ERL_NIF_TERM key, value; +ErlNifMapIterator iter; +enif_map_iterator_create(env, my_map, ERL_NIF_MAP_ITERATOR_FIRST); + +while (enif_map_iterator_get_pair(env, &iter, &key, &value)) { + do_something(key,value); + enif_map_iterator_next(env, &iter); +} +enif_map_iterator_destroy(env, &iter); + </code> + <note><p>The key-value pairs of a map have no defined iteration + order. The only guarantee is that the iteration order of a single map + instance is preserved during the lifetime of the environment that the map + belongs to.</p> + </note> + </desc> + </func> + <func><name><ret>void</ret><nametext>enif_map_iterator_destroy(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Destroy a map iterator</fsummary> + <desc><p>Destroy a map iterator created by + <seealso marker="#enif_map_iterator_create">enif_map_iterator_create</seealso>. + </p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_get_pair(ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)</nametext></name> + <fsummary>Get key and value at current map iterator position</fsummary> + <desc><p>Get key and value terms at current map iterator position. + On success set <c>*key</c> and <c>*value</c> and return true. + Return false if the iterator is positioned at head (before first entry) + or tail (beyond last entry).</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_is_head(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Check if map iterator is positioned before first</fsummary> + <desc><p>Return true if map iterator <c>iter</c> is positioned + before first entry.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_is_tail(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Check if map iterator is positioned after last</fsummary> + <desc><p>Return true if map iterator <c>iter</c> is positioned + after last entry.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_next(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Increment map iterator to point to next entry</fsummary> + <desc><p>Increment map iterator to point to next key-value entry. + Return true if the iterator is now positioned at a valid key-value entry, + or false if the iterator is positioned at the tail (beyond the last + entry).</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_prev(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Decrement map iterator to point to previous entry</fsummary> + <desc><p>Decrement map iterator to point to previous key-value entry. + Return true if the iterator is now positioned at a valid key-value entry, + or false if the iterator is positioned at the head (before the first + entry).</p></desc> + </func> <func><name><ret>ErlNifMutex *</ret><nametext>enif_mutex_create(char *name)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_mutex_create">erl_drv_mutex_create</seealso>. @@ -1169,19 +1289,32 @@ typedef enum { <c>reload</c> or <c>upgrade</c>.</p> <p>Was previously named <c>enif_get_data</c>.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason)</nametext></name> + <fsummary>Raise a NIF error exception</fsummary> + <desc><p>Create an error exception with the term <c>reason</c> 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_raise_exception</c>, the runtime ensures that the exception it creates + is raised when the NIF returns, even if the NIF attempts to return a non-exception + term instead. The return value from <c>enif_raise_exception</c> may be used only as + the return value from the NIF that invoked it (directly 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> + and <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_realloc_binary(ErlNifBinary* bin, size_t size)</nametext></name> - <fsummary>Change the size of a binary.</fsummary> + <fsummary>Change the size of a binary</fsummary> <desc><p>Change the size of a binary <c>bin</c>. The source binary may be read-only, in which case it will be left untouched and a mutable copy is allocated and assigned to <c>*bin</c>. Return true on success, false if memory allocation failed.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_release_binary(ErlNifBinary* bin)</nametext></name> - <fsummary>Release a binary.</fsummary> + <fsummary>Release a binary</fsummary> <desc><p>Release a binary obtained from <c>enif_alloc_binary</c>.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_release_resource(void* obj)</nametext></name> - <fsummary>Release a resource object.</fsummary> + <fsummary>Release a resource object</fsummary> <desc><p>Remove a reference to resource object <c>obj</c>obtained from <seealso marker="#enif_alloc_resource">enif_alloc_resource</seealso>. The resource object will be destructed when the last reference is removed. @@ -1257,12 +1390,12 @@ typedef enum { </desc> </func> <func><name><ret>ErlNifPid *</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> - <fsummary>Get the pid of the calling process.</fsummary> + <fsummary>Get the pid of the calling process</fsummary> <desc><p>Initialize the pid variable <c>*pid</c> to represent the calling process. Return <c>pid</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_send(ErlNifEnv* env, ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)</nametext></name> - <fsummary>Send a message to a process.</fsummary> + <fsummary>Send a message to a process</fsummary> <desc><p>Send a message to a process.</p> <taglist> <tag><c>env</c></tag> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 0e5909a52d..3fea64cef5 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> @@ -465,29 +536,108 @@ </desc> </func> <func> - <name name="cancel_timer" arity="1"/> + <name name="cancel_timer" arity="2"/> <fsummary>Cancel a timer</fsummary> <desc> - <p>Cancels a timer, where <c><anno>TimerRef</anno></c> was returned by - either - <seealso marker="#send_after/3">erlang:send_after/3</seealso> - or - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>. - If the timer is there to be removed, the function returns - the time in milliseconds left until the timer would have expired, - otherwise <c>false</c> (which means that <c><anno>TimerRef</anno></c> was - never a timer, that it has already been cancelled, or that it - has already delivered its message).</p> + <p> + Cancels a timer that has been created by either + <seealso marker="#start_timer/4"><c>erlang:start_timer()</c></seealso>, + or <seealso marker="#send_after/4"><c>erlang:send_after()</c></seealso>. + <c><anno>TimerRef</anno></c> identifies the timer, and + was returned by the BIF that created the timer. + </p> + <p>Currently available <c><anno>Option</anno></c>s:</p> + <taglist> + <tag><c>{async, Async}</c></tag> + <item> + <p> + Asynchronous request for cancellation. <c>Async</c> + defaults to <c>false</c> which will cause the + cancellation to be performed synchronously. When + <c>Async</c> is set to <c>true</c>, the cancel + operation will be performed asynchronously. That is, + <c>erlang:cancel_timer()</c> will send an asynchronous + request for cancellation to the timer service that + manages the timer, and then return <c>ok</c>. + </p> + </item> + <tag><c>{info, Info}</c></tag> + <item> + <p> + Request information about the <c><anno>Result</anno></c> + of the cancellation. <c>Info</c> defaults to <c>true</c> + which means that the <c><anno>Result</anno></c> will + be given. When <c>Info</c> is set to <c>false</c>, no + information about the result of the cancellation + will be given. When the operation is performed</p> + <taglist> + <tag>synchronously</tag> + <item> + <p> + If <c>Info</c> is <c>true</c>, the <c>Result</c> will + returned by <c>erlang:cancel_timer()</c>; otherwise, + <c>ok</c> will be returned. + </p> + </item> + <tag>asynchronously</tag> + <item> + <p> + If <c>Info</c> is <c>true</c>, a message on the form + <c>{cancel_timer, <anno>TimerRef</anno>, + <anno>Result</anno>}</c> will be sent to the + caller of <c>erlang:cancel_timer()</c> when the + cancellation operation has been performed; otherwise, + no message will be sent. + </p> + </item> + </taglist> + </item> + </taglist> + <p> + More <c><anno>Option</anno></c>s may be added in the future. + </p> + <p> + When the <c><anno>Result</anno></c> equals <c>false</c>, a + timer corresponding to <c><anno>TimerRef</anno></c> could not + be found. This can be either because the timer had expired, + already had been canceled, or because <c><anno>TimerRef</anno></c> + never has corresponded to a timer. If the timer has expired, + the timeout message has been sent, but it does not tell you + whether or not it has arrived at its destination yet. When the + <c><anno>Result</anno></c> is an integer, it represents the + time in milli-seconds left until the timer will expire. + </p> + <note> + <p> + The timer service that manages the timer may be co-located + with another scheduler than the scheduler that the calling + process is executing on. If this is the case, communication + with the timer service will take much longer time than if it + is located locally. If the calling process is in critical + path, and can do other things while waiting for the result + of this operation, or is not interested in the result of + the operation, you want to use the <c>{async, true}</c> + option. If using the <c>{async, false}</c> option, the calling + process will be blocked until the operation has been + performed. + </p> + </note> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#start_timer/4"><c>erlang:start_timer/4</c></seealso>, and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> - <p>Note: Cancelling a timer does not guarantee that the message - has not already been delivered to the message queue.</p> + <seealso marker="#read_timer/2"><c>erlang:read_timer/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="cancel_timer" arity="1"/> + <fsummary>Cancel a timer</fsummary> + <desc> + <p>Cancels a timer. The same as calling + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer(TimerRef, + [])</c></seealso>.</p> </desc> </func> - <func> <name name="check_old_code" arity="1"/> <fsummary>Check if a module has old code</fsummary> @@ -585,6 +735,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> @@ -1252,10 +1418,11 @@ true <fsummary>Check if a function is exported and loaded</fsummary> <desc> <p>Returns <c>true</c> if the module <c><anno>Module</anno></c> is loaded - and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>; - otherwise <c>false</c>.</p> - <p>Returns <c>false</c> for any BIF (functions implemented in C - rather than in Erlang).</p> + and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>, + or if there is a BIF (a built-in function implemented in C) + with the given name; otherwise returns <c>false</c>.</p> + <note><p>This function used to return false for built-in + functions before the 18.0 release.</p></note> </desc> </func> <func> @@ -1376,6 +1543,19 @@ true </desc> </func> <func> + <name name="get_keys" arity="0"/> + <fsummary>Return a list of all keys from the process dictionary</fsummary> + <desc> + <p>Returns a list of keys all keys present in the process dictionary.</p> + <pre> +> <input>put(dog, {animal,1}),</input> +<input>put(cow, {animal,2}),</input> +<input>put(lamb, {animal,3}),</input> +<input>get_keys().</input> +[dog,cow,lamb]</pre> + </desc> + </func> + <func> <name name="get_keys" arity="1"/> <fsummary>Return a list of keys from the process dictionary</fsummary> <desc> @@ -2191,14 +2371,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> @@ -2499,97 +2680,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> @@ -2640,6 +2902,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> @@ -2734,6 +3041,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. @@ -2746,10 +3060,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> @@ -4274,23 +4584,77 @@ os_prompt% </pre> </desc> </func> <func> - <name name="read_timer" arity="1"/> - <fsummary>Number of milliseconds remaining for a timer</fsummary> - <desc> - <p><c><anno>TimerRef</anno></c> is a timer reference returned by - <seealso marker="#send_after/3">erlang:send_after/3</seealso> - or - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>. - If the timer is active, the function returns the time in - milliseconds left until the timer will expire, otherwise - <c>false</c> (which means that <c><anno>TimerRef</anno></c> was never a - timer, that it has been cancelled, or that it has already - delivered its message).</p> + <name name="read_timer" arity="2"/> + <fsummary>Read the state of a timer</fsummary> + <desc> + <p> + Read the state of a timer that has been created by either + <seealso marker="#start_timer/4"><c>erlang:start_timer()</c></seealso>, + or <seealso marker="#send_after/4"><c>erlang:send_after()</c></seealso>. + <c><anno>TimerRef</anno></c> identifies the timer, and + was returned by the BIF that created the timer. + </p> + <p>Currently available <c><anno>Option</anno>s</c>:</p> + <taglist> + <tag><c>{async, Async}</c></tag> + <item> + <p> + Asynchronous request for state information. <c>Async</c> + defaults to <c>false</c> which will cause the operation + to be performed synchronously. In this case, the <c>Result</c> + will be returned by <c>erlang:read_timer()</c>. When + <c>Async</c> is set to <c>true</c>, <c>erlang:read_timer()</c> + will send an asynchronous request for the state information + to the timer service that manages the timer, and then return + <c>ok</c>. A message on the format <c>{read_timer, + <anno>TimerRef</anno>, <anno>Result</anno>}</c> will be + sent to the caller of <c>erlang:read_timer()</c> when the + operation has been processed. + </p> + </item> + </taglist> + <p> + More <c><anno>Option</anno></c>s may be added in the future. + </p> + <p> + When the <c><anno>Result</anno></c> equals <c>false</c>, a + timer corresponding to <c><anno>TimerRef</anno></c> could not + be found. This can be either because the timer had expired, + had been canceled, or because <c><anno>TimerRef</anno></c> + never has corresponded to a timer. If the timer has expired, + the timeout message has been sent, but it does not tell you + whether or not it has arrived at its destination yet. When the + <c><anno>Result</anno></c> is an integer, it represents the + time in milli-seconds left until the timer will expire. + </p> + <note> + <p> + The timer service that manages the timer may be co-located + with another scheduler than the scheduler that the calling + process is executing on. If this is the case, communication + with the timer service will take much longer time than if it + is located locally. If the calling process is in critical + path, and can do other things while waiting for the result + of this operation you want to use the <c>{async, true}</c> + option. If using the <c>{async, false}</c> option, the calling + process will be blocked until the operation has been + performed. + </p> + </note> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#start_timer/4"><c>erlang:start_timer/4</c></seealso>, and - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>.</p> + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="read_timer" arity="1"/> + <fsummary>Read the state of a timer</fsummary> + <desc> + <p>Read the state of a timer. The same as calling + <seealso marker="#read_timer/2"><c>erlang:read_timer(TimerRef, + [])</c></seealso>.</p> </desc> </func> <func> @@ -4439,31 +4803,26 @@ true</pre> </desc> </func> <func> + <name name="send_after" arity="4"/> + <fsummary>Start a timer</fsummary> + <desc> + <p> + Starts a timer. When the timer expires, the message + <c><anno>Msg</anno></c> will be sent to the process + identified by <c><anno>Dest</anno></c>. Appart from + the format of the message sent to + <c><anno>Dest</anno></c> when the timer expires + <c>erlang:send_after/4</c> works exactly as + <seealso marker="#start_timer/4"><c>erlang:start_timer/4</c></seealso>.</p> + </desc> + </func> + <func> <name name="send_after" arity="3"/> - <type_desc variable="Time">0 <= Time <= 4294967295</type_desc> <fsummary>Start a timer</fsummary> <desc> - <p>Starts a timer which will send the message <c>Msg</c> - to <c><anno>Dest</anno></c> after <c><anno>Time</anno></c> milliseconds.</p> - <p>If <c><anno>Dest</anno></c> is a <c>pid()</c> it has to be a <c>pid()</c> of a local process, dead or alive.</p> - <p>The <c><anno>Time</anno></c> value can, in the current implementation, not be greater than 4294967295.</p> - <p>If <c><anno>Dest</anno></c> is an <c>atom()</c>, it is supposed to be the name of - a registered process. The process referred to by the name is - looked up at the time of delivery. No error is given if - the name does not refer to a process.</p> - - <p>If <c><anno>Dest</anno></c> is a <c>pid()</c>, the timer will be automatically - canceled if the process referred to by the <c>pid()</c> is not alive, - or when the process exits. This feature was introduced in - erts version 5.4.11. Note that timers will not be - automatically canceled when <c><anno>Dest</anno></c> is an <c>atom</c>.</p> - <p>See also - <seealso marker="#start_timer/3">erlang:start_timer/3</seealso>, - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>, - and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> - <p>Failure: <c>badarg</c> if the arguments does not satisfy - the requirements specified above.</p> + <p>Starts a timer. The same as calling + <seealso marker="#send_after/4"><c>erlang:send_after(<anno>Time</anno>, + <anno>Dest</anno>, <anno>Msg</anno>, [])</c></seealso>.</p> </desc> </func> <func> @@ -4869,34 +5228,81 @@ true</pre> </desc> </func> <func> - <name name="start_timer" arity="3"/> - <type_desc variable="Time">0 <= Time <= 4294967295</type_desc> + <name name="start_timer" arity="4"/> <fsummary>Start a timer</fsummary> <desc> - <p>Starts a timer which will send the message - <c>{timeout, <anno>TimerRef</anno>, <anno>Msg</anno>}</c> to <c><anno>Dest</anno></c> - after <c><anno>Time</anno></c> milliseconds.</p> - <p>If <c><anno>Dest</anno></c> is a <c>pid()</c> it has to be a <c>pid()</c> of a local process, dead or alive.</p> - <p>The <c><anno>Time</anno></c> value can, in the current implementation, not be greater than 4294967295.</p> - <p>If <c><anno>Dest</anno></c> is an <c>atom()</c>, it is supposed to be the name of - a registered process. The process referred to by the name is - looked up at the time of delivery. No error is given if - the name does not refer to a process.</p> - <p>If <c><anno>Dest</anno></c> is a <c>pid()</c>, the timer will be automatically - canceled if the process referred to by the <c>pid()</c> is not alive, - or when the process exits. This feature was introduced in - erts version 5.4.11. Note that timers will not be - automatically canceled when <c><anno>Dest</anno></c> is an <c>atom()</c>.</p> + <p> + Starts a timer. When the timer expires, the message + <c>{timeout, <anno>TimerRef</anno>, <anno>Msg</anno>}</c> + will be sent to the process identified by + <c><anno>Dest</anno></c>. + </p> + <p>Currently available <c><anno>Option</anno></c>s:</p> + <taglist> + <tag><c>{abs, Abs}</c></tag> + <item> + <p> + Absolute <c><anno>Time</anno></c> value. <c>Abs</c> + defaults to <c>false</c> which means that the + <c><anno>Time</anno></c> value will be interpreted + as a time in milli-seconds relative current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. When <c>Abs</c> is set to + <c>true</c>, the <c><anno>Time</anno></c> value will + be interpreted as an absolute Erlang monotonic time of + milli-seconds + <seealso marker="#type_time_unit">time unit</seealso>. + </p> + </item> + </taglist> + <p> + More <c><anno>Option</anno></c>s may be added in the future. + </p> + <p> + The absolute point in time that the timer is set to expire on + has to be in the interval + <c>[</c><seealso marker="#system_info_start_time"><c>erlang:system_info(start_time)</c></seealso><c>, + </c><seealso marker="#system_info_end_time"><c>erlang:system_info(end_time)</c></seealso><c>]</c>. + Further, if a relative time is specified, the <c><anno>Time</anno></c> value + is not allowed to be negative. + </p> + <p> + If <c><anno>Dest</anno></c> is a <c>pid()</c>, it has to + be a <c>pid()</c> of a process created on the current + runtime system instance. This process may or may not + have terminated. If <c><anno>Dest</anno></c> is an + <c>atom()</c>, it will be interpreted as the name of a + locally registered process. The process referred to by the + name is looked up at the time of timer expiration. No error + is given if the name does not refer to a process. + </p> + <p> + If <c><anno>Dest</anno></c> is a <c>pid()</c>, the timer will + be automatically canceled if the process referred to by the + <c>pid()</c> is not alive, or when the process exits. This + feature was introduced in erts version 5.4.11. Note that + timers will not be automatically canceled when + <c><anno>Dest</anno></c> is an <c>atom()</c>. + </p> <p>See also - <seealso marker="#send_after/3">erlang:send_after/3</seealso>, - <seealso marker="#cancel_timer/1">erlang:cancel_timer/1</seealso>, + <seealso marker="#send_after/4"><c>erlang:send_after/4</c></seealso>, + <seealso marker="#cancel_timer/2"><c>erlang:cancel_timer/2</c></seealso>, and - <seealso marker="#read_timer/1">erlang:read_timer/1</seealso>.</p> + <seealso marker="#read_timer/2"><c>erlang:read_timer/2</c></seealso>.</p> <p>Failure: <c>badarg</c> if the arguments does not satisfy the requirements specified above.</p> </desc> </func> <func> + <name name="start_timer" arity="3"/> + <fsummary>Start a timer</fsummary> + <desc> + <p>Starts a timer. The same as calling + <seealso marker="#start_timer/4"><c>erlang:start_timer(<anno>Time</anno>, + <anno>Dest</anno>, <anno>Msg</anno>, [])</c></seealso>.</p> + </desc> + </func> + <func> <name name="statistics" arity="1" clause_i="1"/> <fsummary>Information about context switches</fsummary> <desc> @@ -5496,6 +5902,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"/> @@ -5776,6 +6211,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 @@ -5965,6 +6411,14 @@ ok (i.e. <c>system_info(dynamic_trace)</c> returns <c>dtrace</c> or <c>systemtap</c>).</p> </item> + <tag><marker id="system_info_end_time"/><c>end_time</c></tag> + <item><p>The last <seealso marker="#monotonic_time/0">Erlang monotonic + time</seealso> in <c>native</c> + <seealso marker="#type_time_unit">time unit</seealso> that + can be represented internally in the current Erlang runtime system + instance. The time between the + <seealso marker="#system_info_start_time">start time</seealso> and + the end time is at least a quarter of a millennium.</p></item> <tag><c>elib_malloc</c></tag> <item> <p>This option will be removed in a future release. @@ -6163,6 +6617,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 @@ -6288,6 +6859,13 @@ 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. See also + <seealso marker="#system_info_end_time"><c>erlang:system_info(end_time)</c></seealso>. + </p></item> <tag><c>system_version</c></tag> <item> <p>Returns a string containing version number and @@ -6311,12 +6889,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> @@ -6595,7 +7225,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> @@ -6672,6 +7339,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> @@ -6815,7 +7564,9 @@ ok only allowed with <c>PidSpec==all</c>. If the host machine operating system does not support high resolution CPU time measurements, <c>trace/3</c> exits with - <c>badarg</c>.</p> + <c>badarg</c>. Note that most operating systems do + not synchronize this value across cores, so be prepared + that time might seem to go backwards when using this option.</p> </item> <tag><c>arity</c></tag> <item> @@ -7436,6 +8187,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/init.xml b/erts/doc/src/init.xml index 09b5493341..c5a1a92b92 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -248,7 +248,7 @@ evaluation), Erlang stops with an error message. Here is an example that seeds the random number generator:</p> <pre> -% <input>erl -eval '{X,Y,Z}' = now(), random:seed(X,Y,Z).'</input></pre> +% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre> <p>This example uses Erlang as a hexadecimal calculator:</p> <pre> % <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 334b47d34c..b4cc8e9f78 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -76,22 +76,26 @@ { GuardFunction, ConditionExpression, ... } </item> <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | - <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | - <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | - <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> | - <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | - <c><![CDATA[andalso]]></c> | <c><![CDATA[orelse]]></c></item> + <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | + <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | + <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | + <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | + <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | + <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | + <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | + <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | + <c><![CDATA['xor']]></c> | <c><![CDATA[andalso]]></c> | + <c><![CDATA[orelse]]></c></item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct </item> <item>ExprMatchVariable ::= MatchVariable (bound in the MatchHead) | <c><![CDATA['$_']]></c> | <c><![CDATA['$$']]></c></item> - <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | - <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | NonCompositeTerm | Constant - </item> - <item>NonCompositeTerm ::= term() (not list or tuple) - </item> + <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | + <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | + <c><![CDATA[#{}]]></c> | #{term() => ConditionExpression, ...} | + NonCompositeTerm | Constant</item> + <item>NonCompositeTerm ::= term() (not list or tuple or map)</item> <item>Constant ::= {<c><![CDATA[const]]></c>, term()} </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | @@ -134,22 +138,26 @@ { GuardFunction, ConditionExpression, ... } </item> <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | - <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | - <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | - <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> | - <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | - <c><![CDATA[andalso]]></c> | <c><![CDATA[orelse]]></c></item> + <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | + <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | + <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | + <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | + <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | + <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | + <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | + <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | + <c><![CDATA['xor']]></c> | <c><![CDATA[andalso]]></c> | + <c><![CDATA[orelse]]></c></item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct </item> <item>ExprMatchVariable ::= MatchVariable (bound in the MatchHead) | <c><![CDATA['$_']]></c> | <c><![CDATA['$$']]></c></item> <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | - <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | NonCompositeTerm | Constant - </item> - <item>NonCompositeTerm ::= term() (not list or tuple) - </item> + <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | #{} | + #{term() => ConditionExpression, ...} | NonCompositeTerm | + Constant</item> + <item>NonCompositeTerm ::= term() (not list or tuple or map)</item> <item>Constant ::= {<c><![CDATA[const]]></c>, term()} </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | @@ -172,9 +180,10 @@ <title>Functions allowed in all types of match specifications</title> <p>The different functions allowed in <c><![CDATA[match_spec]]></c> work like this: </p> - <p><em>is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function: </em> Like the corresponding guard tests in - Erlang, return <c><![CDATA[true]]></c> or <c><![CDATA[false]]></c>. - </p> + <p><em>is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, + is_reference, is_tuple, is_map, is_binary, is_function:</em> Like the + corresponding guard tests in Erlang, return <c><![CDATA[true]]></c> or + <c><![CDATA[false]]></c>.</p> <p><em>is_record: </em>Takes an additional parameter, which SHALL be the result of <c><![CDATA[record_info(size, <record_type>)]]></c>, like in <c><![CDATA[{is_record, '$1', rectype, record_info(size, rectype)}]]></c>. diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index a2b4ae49a4..35e6e55e72 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,22 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 6.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The VTS mode in Common Test has been modified to use a + private version of the Webtool application (ct_webtool).</p> + <p> + Own Id: OTP-12704 Aux Id: OTP-10922 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 6.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/doc/src/time_correction.xml b/erts/doc/src/time_correction.xml index 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 7145824f91..659ea1b27f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -112,18 +112,24 @@ NO_INLINE_FUNCTIONS=true else ifeq ($(TYPE),lcnt) -PURIFY = +PURIFY = TYPEMARKER = .lcnt TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT else ifeq ($(TYPE),frmptr) -PURIFY = +PURIFY = OMIT_OMIT_FP=yes TYPEMARKER = .frmptr TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR else +ifeq ($(TYPE),icount) +PURIFY = +TYPEMARKER = .icount +TYPE_FLAGS = @CFLAGS@ -DERTS_OPCODE_COUNTER_SUPPORT +else + # If type isn't one of the above, it *is* opt type... override TYPE=opt PURIFY = @@ -138,6 +144,7 @@ endif endif endif endif +endif comma:=, space:= @@ -342,16 +349,6 @@ endif EPCRE_LIB = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX) DEPLIBS += $(EPCRE_LIB) -PERFCTR_PATH=@PERFCTR_PATH@ -USE_PERFCTR=@USE_PERFCTR@ -ifdef PERFCTR_PATH -LIBS += $(PERFCTR_PATH)/usr.lib/libperfctr.a -else -ifdef USE_PERFCTR -LIBS += -lperfctr -endif -endif - LIBSCTP = @LIBSCTP@ ORG_THR_LIBS=@EMU_THR_LIBS@ @@ -559,9 +556,6 @@ HIPE_ppc64_TAB=hipe/hipe_ppc64.tab $(HIPE_ARCH64_TAB) HIPE_arm_TAB=hipe/hipe_arm.tab HIPE_ARCH_TAB=$(HIPE_$(ARCH)_TAB) BIFS += hipe/hipe_bif0.tab hipe/hipe_bif1.tab hipe/hipe_bif2.tab $(HIPE_ARCH_TAB) -ifdef USE_PERFCTR -BIFS += hipe/hipe_perfctr.tab -endif endif $(TARGET)/erl_bif_table.c \ @@ -657,10 +651,6 @@ COMMON_INCLUDES += -I../include/internal -I../include/internal/$(TARGET) INCLUDES = -I$(TTF_DIR) $(COMMON_INCLUDES) -ifdef PERFCTR_PATH -INCLUDES += -I$(PERFCTR_PATH)/usr.lib -I$(PERFCTR_PATH)/linux/include -endif - ifeq ($(TARGET),win32) $(OBJDIR)/dll_sys.o: sys/$(ERLANG_OSTYPE)/sys.c $(V_CC) $(CFLAGS) -DERL_RUN_SHARED_LIB=1 $(INCLUDES) -c $< -o $@ @@ -764,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\ @@ -788,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 \ @@ -897,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 @@ -920,14 +912,11 @@ HIPE_OBJS= \ $(OBJDIR)/hipe_mode_switch.o \ $(OBJDIR)/hipe_native_bif.o \ $(OBJDIR)/hipe_stack.o $(HIPE_ARCH_OBJS) -ifdef USE_PERFCTR -HIPE_OBJS += $(OBJDIR)/hipe_perfctr.o -endif ifdef HIPE_ENABLED EXTRA_BASE_OBJS += $(HIPE_OBJS) endif -BASE_OBJS = $(RUN_OBJS) $(EMU_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) +BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 5d06a32941..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 @@ -198,6 +205,7 @@ atom dotall atom driver atom driver_options atom dsend +atom dsend_continue_trap atom dunlink atom duplicate_bag atom dupnames @@ -236,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 @@ -279,7 +287,6 @@ atom http httph https http_response http_request http_header http_eoh http_error atom id atom if_clause atom ignore -atom imports atom in atom in_exiting atom inactive @@ -335,6 +342,7 @@ atom max atom maximum atom max_tables max_processes atom mbuf_size +atom md5 atom memory atom memory_internal atom memory_types @@ -344,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 @@ -354,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='/=' @@ -450,6 +463,7 @@ atom ports atom port_count atom port_limit atom port_op +atom positive atom print atom priority atom private @@ -509,6 +523,7 @@ atom schedulers_online atom scheme atom scientific atom scope +atom seconds atom sensitive atom sequential_tracer atom sequential_trace_token @@ -554,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 ef42bb20d3..c769428266 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -40,12 +40,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; @@ -60,8 +57,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; @@ -372,7 +369,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" @@ -399,7 +396,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 */ @@ -1115,25 +1112,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 8bfb7d2ad2..a21622f424 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -241,10 +241,6 @@ BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ void** beam_ops; #endif -#ifndef ERTS_SMP /* Not supported with smp emulator */ -extern int count_instructions; -#endif - #define SWAPIN \ HTOP = HEAP_TOP(c_p); \ E = c_p->stop @@ -566,7 +562,8 @@ extern int count_instructions; 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; } @@ -666,6 +663,9 @@ extern int count_instructions; #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; } @@ -703,9 +703,7 @@ extern int count_instructions; 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 { \ @@ -716,6 +714,15 @@ extern int count_instructions; 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)) ) { \ @@ -964,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. @@ -1081,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 */ /* @@ -1163,14 +1186,15 @@ void process_main(void) Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); -#ifndef NO_JUMP_TABLE - static void* opcodes[] = { DEFINE_OPCODES }; #ifdef ERTS_OPCODE_COUNTER_SUPPORT static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; -#endif +#else +#ifndef NO_JUMP_TABLE + static void* opcodes[] = { DEFINE_OPCODES }; #else int Go; #endif +#endif Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ @@ -1369,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; @@ -1381,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; @@ -1479,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); } @@ -1526,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): { @@ -1541,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): { @@ -1554,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): { @@ -1593,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. @@ -2027,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; + } } } @@ -2113,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; } @@ -2141,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--; @@ -2164,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; } @@ -2206,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--; @@ -2353,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) \ @@ -2434,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); @@ -2447,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 @@ -2499,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; } } @@ -2517,7 +2593,7 @@ get_map_elements_fail: StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { - goto badarg; + goto lb_Cl_error; } } @@ -2775,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)); @@ -2842,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; @@ -2857,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; @@ -2872,6 +2976,8 @@ get_map_elements_fail: goto do_big_arith2; } +#undef DO_BIG_ARITH + do_big_arith2: { Eterm result; @@ -3523,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)); @@ -3556,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); { @@ -3782,8 +3890,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(num_bytes); - bptr->flags = 0; - bptr->orig_size = num_bytes; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -3883,8 +3989,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(tmp_arg1); - bptr->flags = 0; - bptr->orig_size = tmp_arg1; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -4987,14 +5091,14 @@ get_map_elements_fail: * ... remainder of original BEAM code */ ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; } OpCase(hipe_trap_call_closure): { ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; @@ -5028,7 +5132,10 @@ get_map_elements_fail: case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); MoveReturn(reg[0], r(0)); - case HIPE_MODE_SWITCH_RES_CALL: + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: + c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; + /*fall through*/ + case HIPE_MODE_SWITCH_RES_CALL_BEAM: SET_I(c_p->i); r(0) = reg[0]; Dispatch(); @@ -5145,22 +5252,14 @@ get_map_elements_fail: #ifndef NO_JUMP_TABLE #ifdef ERTS_OPCODE_COUNTER_SUPPORT - - /* Are tables correctly generated by beam_makeops? */ - ASSERT(sizeof(counting_opcodes) == sizeof(opcodes)); - - if (count_instructions) { #ifdef DEBUG - counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); + counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); #endif - counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); - beam_ops = counting_opcodes; - } - else -#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ - { - beam_ops = opcodes; - } + counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); + beam_ops = counting_opcodes; +#else /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ + beam_ops = opcodes; +#endif /* ERTS_OPCODE_COUNTER_SUPPORT */ #endif /* NO_JUMP_TABLE */ em_call_error_handler = OpCode(call_error_handler); @@ -5273,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 */ }; /* @@ -5476,18 +5577,35 @@ next_catch(Process* c_p, Eterm *reg) { static void terminate_proc(Process* c_p, Eterm Value) { + Eterm *hp; + Eterm Args = NIL; + /* Add a stacktrace if this is an error. */ if (GET_EXC_CLASS(c_p->freason) == EXTAG_ERROR) { Value = add_stacktrace(c_p, Value, c_p->ftrace); } /* EXF_LOG is a primary exception flag */ if (c_p->freason & EXF_LOG) { + int alive = erts_is_alive; erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Error in process %T ", c_p->common.id); - if (erts_is_alive) - erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname); - erts_dsprintf(dsbufp,"with exit value: %0.*T\n", display_items, Value); - erts_send_error_to_logger(c_p->group_leader, dsbufp); + + /* Build the format message */ + erts_dsprintf(dsbufp, "Error in process ~p "); + if (alive) + erts_dsprintf(dsbufp, "on node ~p "); + erts_dsprintf(dsbufp, "with exit value:~n~p~n"); + + /* Build the args in reverse order */ + hp = HAlloc(c_p, 2); + Args = CONS(hp, Value, Args); + if (alive) { + hp = HAlloc(c_p, 2); + Args = CONS(hp, erts_this_node->sysname, Args); + } + hp = HAlloc(c_p, 2); + Args = CONS(hp, c_p->common.id, Args); + + erts_send_error_term_to_logger(c_p->group_leader, dsbufp, Args); } /* * If we use a shared heap, the process will be garbage-collected. @@ -5529,6 +5647,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); @@ -5831,7 +5951,7 @@ build_stacktrace(Process* c_p, Eterm exc) { * (e.g. spawn_link(erlang, abs, [1])). */ if (fi.current == NULL) { - erts_set_current_function(&fi, c_p->initial); + erts_set_current_function(&fi, c_p->u.initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -6039,13 +6159,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()]; } @@ -6094,13 +6208,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()]; } @@ -6422,57 +6530,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) \ @@ -6505,7 +6631,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)); @@ -6514,12 +6672,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; @@ -6528,7 +6685,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 @@ -6538,7 +6695,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; @@ -6548,12 +6705,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. @@ -6568,14 +6756,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); } /* @@ -6606,16 +6793,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; @@ -6701,8 +6887,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; } @@ -6717,7 +6914,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; @@ -6726,18 +6923,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; } @@ -6745,13 +6985,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); } /* @@ -6761,23 +7001,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 */ @@ -6810,6 +7047,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 41c1b5d2c2..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" @@ -245,7 +246,7 @@ typedef struct { /* * This structure contains all information about the module being loaded. */ - +#define MD5_SIZE 16 typedef struct LoaderState { /* * The current logical file within the binary. @@ -292,7 +293,7 @@ typedef struct LoaderState { StringPatch* string_patches; /* Linked list of position into string table to patch. */ BeamInstr catches; /* Linked list of catch_yf instructions. */ unsigned loaded_size; /* Final size of code when loaded. */ - byte mod_md5[16]; /* MD5 for module code. */ + byte mod_md5[MD5_SIZE]; /* MD5 for module code. */ int may_load_nif; /* true if NIFs may later be loaded for this module */ int on_load; /* Index in the code for the on_load function * (or 0 if there is no on_load function) @@ -528,6 +529,8 @@ static Eterm exported_from_module(Process* p, Eterm mod); 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); @@ -648,6 +651,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, stp->code[MI_COMPILE_PTR] = 0; stp->code[MI_COMPILE_SIZE] = 0; stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_MD5_PTR] = 0; /* * Read the atom table. @@ -3169,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)); } @@ -3319,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. @@ -3336,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; @@ -3346,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; } @@ -3600,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; } @@ -3959,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* @@ -3968,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; } @@ -4042,7 +4333,7 @@ freeze_code(LoaderState* stp) } size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) + - strtab_size + attr_size + compile_size + line_size; + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; /* * Move the code to its final location. @@ -4251,11 +4542,20 @@ freeze_code(LoaderState* stp) code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); + { + byte* md5_sum = str_table + strtab_size + attr_size + compile_size; + CHKBLK(ERTS_ALC_T_CODE,code); + sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE); + CHKBLK(ERTS_ALC_T_CODE,code); + code[MI_MD5_PTR] = (BeamInstr) md5_sum; + CHKBLK(ERTS_ALC_T_CODE,code); + } + CHKBLK(ERTS_ALC_T_CODE,code); /* * Make sure that we have not overflowed the allocated code space. */ - ASSERT(str_table + strtab_size + attr_size + compile_size == + ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE == ((byte *) code) + size); /* @@ -5108,10 +5408,14 @@ erts_module_info_0(Process* p, Eterm module) hp += 3; \ 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_imports); BUILD_INFO(am_exports); + BUILD_INFO(am_module); #undef BUILD_INFO return list; } @@ -5121,8 +5425,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) { if (what == am_module) { return module; - } else if (what == am_imports) { - return NIL; + } else if (what == am_md5) { + return md5_of_module(p, module); } else if (what == am_exports) { return exported_from_module(p, module); } else if (what == am_functions) { @@ -5133,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; } @@ -5193,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},...] * @@ -5311,7 +5664,7 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5350,7 +5703,7 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5373,6 +5726,37 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ } /* + * Returns the MD5 checksum for a module + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +md5_of_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + BeamInstr* code; + Eterm res = NIL; + + 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; + } + code = modp->curr.code; + if (code[MI_MD5_PTR] != 0) { + res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + } else { + res = am_undefined; + } + return res; +} + +/* * Build a single {M,F,A,Loction} item to be part of * a stack trace. */ @@ -5548,7 +5932,7 @@ code_module_md5_1(BIF_ALIST_1) res = am_undefined; goto done; } - res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5)); + res = new_binary(p, stp->mod_md5, MD5_SIZE); done: erts_free_aligned_binary_bytes(temp_alloc); @@ -5841,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; @@ -5869,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; } @@ -5924,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; @@ -5944,6 +6333,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) code[MI_LITERALS_END] = 0; code[MI_LITERALS_OFF_HEAP] = 0; code[MI_ON_LOAD_FUNCTION_PTR] = 0; + code[MI_MD5_PTR] = 0; ci = MI_FUNCTIONS + n + 1; /* @@ -6029,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 bd22b0c4de..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; @@ -91,7 +91,6 @@ extern Uint erts_total_code_size; #define MI_LITERALS_END 8 #define MI_LITERALS_OFF_HEAP 9 - /* * Pointer to the on_load function (or NULL if none). */ @@ -103,6 +102,11 @@ extern Uint erts_total_code_size; #define MI_LINE_TABLE 11 /* + * Pointer to the module MD5 sum (16 bytes) + */ +#define MI_MD5_PTR 12 + +/* * Start of function pointer table. This table contains pointers to * all functions in the module plus an additional pointer just beyond * the end of the last function. @@ -111,7 +115,7 @@ extern Uint erts_total_code_size; * this table. */ -#define MI_FUNCTIONS 12 +#define MI_FUNCTIONS 13 /* * Layout of the line table. diff --git a/erts/emulator/beam/benchmark.c b/erts/emulator/beam/benchmark.c index 8613131176..b16fe6b271 100644 --- a/erts/emulator/beam/benchmark.c +++ b/erts/emulator/beam/benchmark.c @@ -37,37 +37,9 @@ unsigned long long major_gc; #ifdef BM_TIMERS -#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR - -#include "libperfctr.h" -struct vperfctr *system_clock; -double cpu_khz; -BM_NEW_TIMER(start); - -static double get_hrvtime(void) -{ - unsigned long long ticks; - double milli_seconds; - - ticks = vperfctr_read_tsc(system_clock); - milli_seconds = (double)ticks / cpu_khz; - return milli_seconds; -} - -static void stop_hrvtime(void) -{ - if(system_clock) - { - vperfctr_stop(system_clock); - vperfctr_close(system_clock); - system_clock = NULL; - } -} - -#else /* not perfctr, asuming Solaris */ +/* assuming Solaris */ #include <time.h> BM_TIMER_T system_clock; -#endif unsigned long local_pause_times[MAX_PAUSE_TIME]; unsigned long pause_times[MAX_PAUSE_TIME]; @@ -117,40 +89,6 @@ unsigned long long message_sizes[1000]; void init_benchmarking() { #ifdef BM_TIMERS -#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR - /* pass `--with-perfctr=/path/to/perfctr' when configuring */ - struct perfctr_info info; - struct vperfctr_control control; - int i; - - system_clock = vperfctr_open(); - if (system_clock != NULL) - { - if (vperfctr_info(system_clock,&info) >= 0) - { - cpu_khz = (double)info.cpu_khz; - if (info.cpu_features & PERFCTR_FEATURE_RDTSC) - { - memset(&control,0,sizeof control); - control.cpu_control.tsc_on = 1; - } - } - if (vperfctr_control(system_clock,&control) < 0) - { - vperfctr_close(system_clock); - system_clock = NULL; - } - } - - for (i = 0; i < 1000; i++) - { - BM_START_TIMER(system); - BM_STOP_TIMER(system); - } - - timer_time = system_time / 1000; - start_time = 0; -#else int i; for (i = 0; i < 1000; i++) { @@ -158,7 +96,6 @@ void init_benchmarking() BM_STOP_TIMER(system); } timer_time = system_time / 1000; -#endif for (i = 0; i < MAX_PAUSE_TIME; i++) { local_pause_times[i] = 0; diff --git a/erts/emulator/beam/benchmark.h b/erts/emulator/beam/benchmark.h index 766edaac42..7fc3933f3d 100644 --- a/erts/emulator/beam/benchmark.h +++ b/erts/emulator/beam/benchmark.h @@ -37,10 +37,7 @@ /* BM_TIMERS keeps track of the time spent in diferent parts of the * system. It only measures accual active time, not time spent in idle - * mode. These timers requires hardware support. For Linux, use the - * package perfctr from user.it.uu.se/~mikpe/linux/perfctr. If this - * package is not specified when configuring the system - * (--with-perfctr=PATH), the Solaris hrtime_t will be used. + * mode. Currently, the Solaris hrtime_t will be used. * To add new timers look below. */ #define BM_TIMERS @@ -142,43 +139,12 @@ extern unsigned long long major_gc; * meassure (send time in shared heap for instance). */ -#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR -#include "libperfctr.h" +/* (Assuming Solaris) */ -#define BM_TIMER_T double - -extern struct vperfctr *system_clock; -extern double cpu_khz; -extern BM_TIMER_T start_time; - -#define BM_START_TIMER(t) start_time = \ - (BM_TIMER_T)vperfctr_read_tsc(system_clock) / \ - cpu_khz; - -#define BM_STOP_TIMER(t) do { \ - BM_TIMER_T tmp = ((BM_TIMER_T)vperfctr_read_tsc(system_clock) / cpu_khz); \ - tmp -= (start_time + timer_time); \ - t##_time += (tmp > 0 ? tmp : 0); \ -} while(0) - -#define BM_TIME_PRINTER(str,time) do { \ - int min,sec,milli,micro; \ - BM_TIMER_T tmp = (time) * 1000; \ - micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ - tmp /= 1000; \ - milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ - tmp /= 1000; \ - sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \ - min = (uint)tmp / 60; \ - erts_fprintf(file,str": %d:%02d.%03d %03d\n",min,sec,milli,micro); \ -} while(0) - -#else /* !USE_PERFCTR (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) @@ -196,7 +162,6 @@ extern BM_TIMER_T start_time; } while(0) extern BM_TIMER_T system_clock; -#endif /* USE_PERFCTR */ extern BM_TIMER_T timer_time; extern BM_TIMER_T system_time; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index b43137597e..2b782f4484 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -28,7 +28,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_version.h" @@ -40,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) /* @@ -391,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 */ @@ -415,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) @@ -490,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); @@ -508,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; @@ -530,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); @@ -587,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; @@ -615,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); @@ -744,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) @@ -793,7 +832,6 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) return ret; } - /**********************************************************************/ /* this is a combination of the spawn and link BIFs */ @@ -1777,6 +1815,8 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1) * erlang:'!'/2 */ +HIPE_WRAPPER_BIF_DISABLE_GC(ebif_bang, 2) + BIF_RETTYPE ebif_bang_2(BIF_ALIST_2) { @@ -1795,34 +1835,36 @@ ebif_bang_2(BIF_ALIST_2) #define SEND_USER_ERROR (-5) #define SEND_INTERNAL_ERROR (-6) #define SEND_AWAIT_RESULT (-7) +#define SEND_YIELD_CONTINUE (-8) -Sint do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp); + +Sint do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext*); static Sint remote_send(Process *p, DistEntry *dep, - Eterm to, Eterm full_to, Eterm msg, int suspend) + Eterm to, Eterm full_to, Eterm msg, + ErtsSendContext* ctx) { Sint res; int code; - ErtsDSigData dsd; ASSERT(is_atom(to) || is_external_pid(to)); - code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, !suspend); + code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: res = SEND_TRAP; break; case ERTS_DSIG_PREP_WOULD_SUSPEND: - ASSERT(!suspend); + ASSERT(!ctx->suspend); res = SEND_YIELD; break; case ERTS_DSIG_PREP_CONNECTED: { if (is_atom(to)) - code = erts_dsig_send_reg_msg(&dsd, to, msg); + code = erts_dsig_send_reg_msg(to, msg, ctx); else - code = erts_dsig_send_msg(&dsd, to, msg); + code = erts_dsig_send_msg(to, msg, ctx); /* * Note that reductions have been bumped on calling * process by erts_dsig_send_reg_msg() or @@ -1830,6 +1872,8 @@ static Sint remote_send(Process *p, DistEntry *dep, */ if (code == ERTS_DSIG_SEND_YIELD) res = SEND_YIELD_RETURN; + else if (code == ERTS_DSIG_SEND_CONTINUE) + res = SEND_YIELD_CONTINUE; else res = 0; break; @@ -1850,7 +1894,8 @@ static Sint remote_send(Process *p, DistEntry *dep, } Sint -do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { +do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) +{ Eterm portid; Port *pt; Process* rp; @@ -1883,7 +1928,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { #endif return 0; } - return remote_send(p, dep, to, to, msg, suspend); + return remote_send(p, dep, to, to, msg, ctx); } else if (is_atom(to)) { Eterm id = erts_whereis_name_to_id(p, to); @@ -1940,7 +1985,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { ret_val = 0; if (pt) { - int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; + int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; *refp = NIL; switch (erts_port_command(p, ps_flags, pt, msg, refp)) { @@ -1949,12 +1994,12 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { return SEND_USER_ERROR; case ERTS_PORT_OP_BUSY: /* Nothing has been sent */ - if (suspend) + if (ctx->suspend) erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); return SEND_YIELD; case ERTS_PORT_OP_BUSY_SCHEDULED: /* Message was sent */ - if (suspend) { + if (ctx->suspend) { erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); ret_val = SEND_YIELD_RETURN; break; @@ -2034,9 +2079,14 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { return 0; } - ret = remote_send(p, dep, tp[1], to, msg, suspend); - if (dep) - erts_deref_dist_entry(dep); + ret = remote_send(p, dep, tp[1], to, msg, ctx); + if (ret != SEND_YIELD_CONTINUE) { + if (dep) { + erts_deref_dist_entry(dep); + } + } else { + ctx->dep_to_deref = dep; + } return ret; } else { if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */ @@ -2067,9 +2117,11 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } } +HIPE_WRAPPER_BIF_DISABLE_GC(send, 3) BIF_RETTYPE send_3(BIF_ALIST_3) { + BIF_RETTYPE retval; Eterm ref; Process *p = BIF_P; Eterm to = BIF_ARG_1; @@ -2077,34 +2129,44 @@ BIF_RETTYPE send_3(BIF_ALIST_3) Eterm opts = BIF_ARG_3; int connect = !0; - int suspend = !0; Eterm l = opts; Sint result; - + DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); + + ctx->suspend = !0; + ctx->dep_to_deref = NULL; + ctx->return_term = am_ok; + ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); + ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; + while (is_list(l)) { if (CAR(list_val(l)) == am_noconnect) { connect = 0; } else if (CAR(list_val(l)) == am_nosuspend) { - suspend = 0; + ctx->suspend = 0; } else { - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); + goto done; } l = CDR(list_val(l)); } if(!is_nil(l)) { - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); + goto done; } #ifdef DEBUG ref = NIL; #endif - result = do_send(p, to, msg, suspend, &ref); + result = do_send(p, to, msg, &ref, ctx); if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(am_ok); + ERTS_BIF_PREP_RET(retval, am_ok); + goto done; } switch (result) { @@ -2112,68 +2174,127 @@ BIF_RETTYPE send_3(BIF_ALIST_3) /* May need to yield even though we do not bump reds here... */ if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(am_ok); + ERTS_BIF_PREP_RET(retval, am_ok); break; case SEND_TRAP: if (connect) { - BIF_TRAP3(dsend3_trap, p, to, msg, opts); + ERTS_BIF_PREP_TRAP3(retval, dsend3_trap, p, to, msg, opts); } else { - BIF_RET(am_noconnect); + ERTS_BIF_PREP_RET(retval, am_noconnect); } break; case SEND_YIELD: - if (suspend) { - ERTS_BIF_YIELD3(bif_export[BIF_send_3], p, to, msg, opts); + if (ctx->suspend) { + ERTS_BIF_PREP_YIELD3(retval, + bif_export[BIF_send_3], p, to, msg, opts); } else { - BIF_RET(am_nosuspend); + ERTS_BIF_PREP_RET(retval, am_nosuspend); } break; case SEND_YIELD_RETURN: - if (!suspend) - BIF_RET(am_nosuspend); + if (!ctx->suspend) { + ERTS_BIF_PREP_RET(retval, am_nosuspend); + break; + } yield_return: - ERTS_BIF_YIELD_RETURN(p, am_ok); + ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok); + break; case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); - BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok); + ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok); + break; case SEND_BADARG: - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; case SEND_USER_ERROR: - BIF_ERROR(p, EXC_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; case SEND_INTERNAL_ERROR: - BIF_ERROR(p, EXC_INTERNAL_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR); + break; + case SEND_YIELD_CONTINUE: + BUMP_ALL_REDS(p); + erts_set_gc_state(p, 0); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, + erts_dsend_export_trap_context(p, ctx)); break; default: - ASSERT(! "Illegal send result"); + erl_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result); break; } - ASSERT(! "Can not arrive here"); - BIF_ERROR(p, BADARG); + +done: + UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); + return retval; } +HIPE_WRAPPER_BIF_DISABLE_GC(send, 2) + BIF_RETTYPE send_2(BIF_ALIST_2) { return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); } +static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) +{ + Binary* bin = ((ProcBin*) binary_val(BIF_ARG_1))->val; + ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin); + Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR); + int result; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor); + + ctx->dss.reds = initial_reds; + result = erts_dsig_send(&ctx->dsd, &ctx->dss); + + switch (result) { + case ERTS_DSIG_SEND_OK: + erts_set_gc_state(BIF_P, 1); + BIF_RET(ctx->return_term); + break; + case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/ + erts_set_gc_state(BIF_P, 1); + if (!ctx->suspend) + BIF_RET(am_nosuspend); + ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term); + + case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/ + BUMP_ALL_REDS(BIF_P); + BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1); + } + default: + erl_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result); + break; + } + ASSERT(! "Can not arrive here"); + BIF_ERROR(BIF_P, BADARG); +} + Eterm erl_send(Process *p, Eterm to, Eterm msg) { + Eterm retval; Eterm ref; Sint result; + DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); #ifdef DEBUG ref = NIL; #endif + ctx->suspend = !0; + ctx->dep_to_deref = NULL; + ctx->return_term = msg; + ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); + ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; - result = do_send(p, to, msg, !0, &ref); + result = do_send(p, to, msg, &ref, ctx); if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(msg); + ERTS_BIF_PREP_RET(retval, msg); + goto done; } switch (result) { @@ -2181,35 +2302,46 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) /* May need to yield even though we do not bump reds here... */ if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(msg); + ERTS_BIF_PREP_RET(retval, msg); break; case SEND_TRAP: - BIF_TRAP2(dsend2_trap, p, to, msg); + ERTS_BIF_PREP_TRAP2(retval, dsend2_trap, p, to, msg); break; case SEND_YIELD: - ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); + ERTS_BIF_PREP_YIELD2(retval, bif_export[BIF_send_2], p, to, msg); break; case SEND_YIELD_RETURN: yield_return: - ERTS_BIF_YIELD_RETURN(p, msg); + ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg); + break; case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); - BIF_TRAP3(await_port_send_result_trap, p, ref, msg, msg); + ERTS_BIF_PREP_TRAP3(retval, + await_port_send_result_trap, p, ref, msg, msg); + break; case SEND_BADARG: - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; case SEND_USER_ERROR: - BIF_ERROR(p, EXC_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; case SEND_INTERNAL_ERROR: - BIF_ERROR(p, EXC_INTERNAL_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR); + break; + case SEND_YIELD_CONTINUE: + BUMP_ALL_REDS(p); + erts_set_gc_state(p, 0); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, + erts_dsend_export_trap_context(p, ctx)); break; default: - ASSERT(! "Illegal send result"); + erl_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result); break; } - ASSERT(! "Can not arrive here"); - BIF_ERROR(p, BADARG); + +done: + UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); + return retval; } /**********************************************************************/ @@ -3448,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) @@ -3998,16 +4045,19 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) BIF_RETTYPE function_exported_3(BIF_ALIST_3) { + int arity; if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) { BIF_ERROR(BIF_P, BADARG); } - if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3), - erts_active_code_ix()) == NULL) { - BIF_RET(am_false); + arity = signed_val(BIF_ARG_3); + if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity, + erts_active_code_ix()) != NULL || + erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) { + BIF_RET(am_true); } - BIF_RET(am_true); + BIF_RET(am_false); } /**********************************************************************/ @@ -4510,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)) @@ -4797,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); @@ -4818,9 +4885,21 @@ void erts_init_bif(void) #endif , &bif_return_trap); - flush_monitor_message_trap = erts_export_put(am_erlang, - am_flush_monitor_message, - 2); + 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_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 72c55ccb55..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 \ @@ -465,6 +469,8 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifdef ERL_WANT_HIPE_BIF_WRAPPER__ + #ifndef HIPE #define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) @@ -509,6 +515,7 @@ BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ #endif +#endif /* ERL_WANT_HIPE_BIF_WRAPPER__ */ #include "erl_bif_table.h" diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index e68b8e6274..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 @@ -194,15 +209,20 @@ bif math:erf/1 bif math:erfc/1 bif math:exp/1 bif math:log/1 +bif math:log2/1 bif math:log10/1 bif math:sqrt/1 bif math:atan2/2 bif math:pow/2 bif erlang:start_timer/3 +bif erlang:start_timer/4 bif erlang:send_after/3 +bif erlang:send_after/4 bif erlang:cancel_timer/1 +bif erlang:cancel_timer/2 bif erlang:read_timer/1 +bif erlang:read_timer/2 bif erlang:make_tuple/2 bif erlang:append_element/2 @@ -347,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) @@ -578,7 +600,7 @@ bif io:printable_range/0 bif os:unsetenv/1 # -# New in R17A +# New in 17.0 # bif re:inspect/2 @@ -600,10 +622,21 @@ bif maps:values/1 bif erts_internal:cmp_term/2 +bif ets:take/2 + # -# New in 17.1. +# New in 17.1 # + bif erlang:fun_info_mfa/1 + +# New in 18.0 +# + +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 d1e46e3063..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 */ 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/binary.c b/erts/emulator/beam/binary.c index f50d484576..cc0b3b9b6c 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -26,7 +26,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" @@ -83,8 +85,6 @@ new_binary(Process *p, byte *buf, Uint len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -122,8 +122,6 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -177,7 +175,6 @@ erts_realloc_binary(Eterm bin, size_t size) } else { /* REFC */ ProcBin* pb = (ProcBin *) bval; Binary* newbin = erts_bin_realloc(pb->val, size); - newbin->orig_size = size; pb->val = newbin; pb->size = size; pb->bytes = (byte*) newbin->orig_bytes; diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 2cddfe2800..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; @@ -209,25 +209,12 @@ print_process_info(int to, void *to_arg, Process *p) erts_print(to, to_arg, "State: "); state = erts_smp_atomic32_read_acqb(&p->state); - if (state & ERTS_PSFLG_FREE) - erts_print(to, to_arg, "Non Existing\n"); /* Should never happen */ - else if (state & ERTS_PSFLG_EXITING) - erts_print(to, to_arg, "Exiting\n"); - else if (state & ERTS_PSFLG_GC) { - garbing = 1; - running = 1; - erts_print(to, to_arg, "Garbing\n"); - } - else if (state & ERTS_PSFLG_SUSPENDED) - erts_print(to, to_arg, "Suspended\n"); - else if (state & ERTS_PSFLG_RUNNING) { - running = 1; - erts_print(to, to_arg, "Running\n"); - } - else if (state & ERTS_PSFLG_ACTIVE) - erts_print(to, to_arg, "Scheduled\n"); - else - erts_print(to, to_arg, "Waiting\n"); + erts_dump_process_state(to, to_arg, state); + if (state & ERTS_PSFLG_GC) { + garbing = 1; + running = 1; + } else if (state & ERTS_PSFLG_RUNNING) + running = 1; /* * If the process is registered as a global process, display the @@ -240,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) { @@ -351,6 +338,10 @@ print_process_info(int to, void *to_arg, Process *p) #endif erts_stack_dump(to, to_arg, p); } + + /* Display all states */ + erts_print(to, to_arg, "Internal State: "); + erts_dump_extended_process_state(to, to_arg, state); } static void @@ -680,27 +671,39 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) char* dumpname; int secs; int env_erl_crash_dump_seconds_set = 1; + int i; if (ERTS_SOMEONE_IS_CRASH_DUMPING) return; #ifdef ERTS_SMP + /* Order all managed threads to block, this has to be done + first to guarantee that this is the only thread to generate + crash dump. */ + erts_thr_progress_fatal_error_block(&tpd_buf); + +#ifdef ERTS_THR_HAVE_SIG_FUNCS /* - * Wait for all managed threads to block. If all threads haven't blocked - * after a minute, we go anyway and hope for the best... - * - * We do not release system again. We expect an exit() or abort() after - * dump has been written. + * We suspend all scheduler threads so that we can dump some + * data about the currently running processes and scheduler data. + * We have to be very very careful when doing this as the schedulers + * could be anywhere. */ - erts_thr_progress_fatal_error_block(60000, &tpd_buf); - /* Either worked or not... */ + for (i = 0; i < erts_no_schedulers; i++) { + erts_tid_t tid = ERTS_SCHEDULER_IX(i)->tid; + if (!erts_equal_tids(tid,erts_thr_self())) + sys_thr_suspend(tid); + } + +#endif /* Allow us to pass certain places without locking... */ erts_smp_atomic32_set_mb(&erts_writing_erl_crash_dump, 1); erts_smp_tsd_set(erts_is_crash_dumping_key, (void *) 1); -#else + +#else /* !ERTS_SMP */ erts_writing_erl_crash_dump = 1; -#endif +#endif /* ERTS_SMP */ envsz = sizeof(env); /* ERL_CRASH_DUMP_SECONDS not set @@ -753,11 +756,12 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) dumpname = "erl_crash.dump"; else dumpname = &dumpnamebuf[0]; + + erts_fprintf(stderr,"\nCrash dump is being written to: %s...", dumpname); fd = open(dumpname,O_WRONLY | O_CREAT | O_TRUNC,0640); - if (fd < 0) + if (fd < 0) return; /* Can't create the crash dump, skip it */ - time(&now); erts_fdprintf(fd, "=erl_crash_dump:0.3\n%s", ctime(&now)); @@ -771,9 +775,74 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) erts_fdprintf(fd, "System version: "); erts_print_system_version(fd, NULL, NULL); erts_fdprintf(fd, "%s\n", "Compiled: " ERLANG_COMPILE_DATE); + erts_fdprintf(fd, "Taints: "); erts_print_nif_taints(fd, NULL); erts_fdprintf(fd, "Atoms: %d\n", atom_table_size()); + +#ifdef USE_THREADS + /* We want to note which thread it was that called erl_exit */ + if (erts_get_scheduler_data()) { + erts_fdprintf(fd, "Calling Thread: scheduler:%d\n", + erts_get_scheduler_data()->no); + } else { + if (!erts_thr_getname(erts_thr_self(), dumpnamebuf, MAXPATHLEN)) + erts_fdprintf(fd, "Calling Thread: %s\n", dumpnamebuf); + else + erts_fdprintf(fd, "Calling Thread: %p\n", erts_thr_self()); + } +#else + erts_fdprintf(fd, "Calling Thread: scheduler:1\n"); +#endif + +#if defined(ERTS_HAVE_TRY_CATCH) + + /* + * erts_print_scheduler_info is not guaranteed to be safe to call + * here for all schedulers as we may have suspended a scheduler + * in the middle of updating the STACK_TOP and STACK_START + * variables and thus when scanning the stack we could get + * segmentation faults. We protect against this very unlikely + * scenario by using the ERTS_SYS_TRY_CATCH. + */ + for (i = 0; i < erts_no_schedulers; i++) { + ERTS_SYS_TRY_CATCH( + erts_print_scheduler_info(fd, NULL, ERTS_SCHEDULER_IX(i)), + erts_fdprintf(fd, "** crashed **\n")); + } +#endif + +#ifdef ERTS_SMP + +#if defined(ERTS_THR_HAVE_SIG_FUNCS) + + /* We resume all schedulers so that we are in a known safe state + when we write the rest of the crash dump */ + for (i = 0; i < erts_no_schedulers; i++) { + erts_tid_t tid = ERTS_SCHEDULER_IX(i)->tid; + if (!erts_equal_tids(tid,erts_thr_self())) + sys_thr_resume(tid); + } +#endif + + /* + * Wait for all managed threads to block. If all threads haven't blocked + * after a minute, we go anyway and hope for the best... + * + * We do not release system again. We expect an exit() or abort() after + * dump has been written. + */ + erts_thr_progress_fatal_error_wait(60000); + /* Either worked or not... */ +#endif + +#ifndef ERTS_HAVE_TRY_CATCH + /* This is safe to call here, as all schedulers are blocked */ + for (i = 0; i < erts_no_schedulers; i++) { + erts_print_scheduler_info(fd, NULL, ERTS_SCHEDULER_IX(i)); + } +#endif + info(fd, NULL); /* General system info */ if (erts_ptab_initialized(&erts_proc)) process_info(fd, NULL); /* Info about each process and port */ @@ -803,7 +872,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) erts_fdprintf(fd, "=end\n"); close(fd); - erts_fprintf(stderr,"\nCrash dump was written to: %s\n", dumpname); + erts_fprintf(stderr,"done\n"); } void 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 50548850eb..850606dd86 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -21,6 +21,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -125,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; @@ -152,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: @@ -338,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; @@ -457,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--) { @@ -471,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"); @@ -565,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: @@ -605,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 ec07ddcd9c..142fcb3c00 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -119,7 +119,7 @@ Export* dmonitor_p_trap = NULL; /* forward declarations */ static void clear_dist_entry(DistEntry*); -static int dsig_send(ErtsDSigData *, Eterm, Eterm, int); +static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy); static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm); static void init_nodes_monitors(void); @@ -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); } @@ -622,9 +618,7 @@ alloc_dist_obuf(Uint size) ErtsDistOutputBuf *obuf; Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1); Binary *bin = erts_bin_drv_alloc(obuf_size); - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) obuf_size; obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; #ifdef DEBUG obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; @@ -709,6 +703,55 @@ static void clear_dist_entry(DistEntry *dep) } } +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_WSTACK(&ctx->dss.u.sc.wstack); + break; + case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: + DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack); + break; + default:; + } + if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) { + free_dist_obuf(ctx->dss.obuf); + } + if (ctx->dep_to_deref) + erts_deref_dist_entry(ctx->dep_to_deref); +} + +Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) +{ + struct exported_ctx { + ErtsSendContext ctx; + ErtsAtomCacheMap acm; + }; + Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), + erts_dsend_context_dtor); + struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); + Uint ctl_size = !HALFWORD_HEAP ? 0 : (arityval(ctx->ctl_heap[0]) + 1); + Eterm* hp = HAlloc(p, ctl_size + PROC_BIN_SIZE); + + sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext)); + ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap)); +#if !HALFWORD_HEAP + dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap); +#else + /* Must put control tuple in low mem */ + sys_memcpy(hp, ctx->ctl_heap, ctl_size*sizeof(Eterm)); + dst->ctx.dss.ctl = make_tuple(hp); + hp += ctl_size; +#endif + if (ctx->dss.acmp) { + sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); + dst->ctx.dss.acmp = &dst->acm; + } + return erts_mk_magic_binary_term(&hp, &MSO(p), ctx_bin); +} + + /* * The erts_dsig_send_*() functions implemented below, sends asynchronous * distributed signals to other Erlang nodes. Before sending a distributed @@ -731,7 +774,7 @@ erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote) int res; UseTmpHeapNoproc(4); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -744,7 +787,7 @@ erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote) int res; UseTmpHeapNoproc(4); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -772,7 +815,7 @@ erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, erts_smp_de_links_unlock(dsdp->dep); #endif - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(6); return res; } @@ -793,7 +836,7 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, make_small(DOP_MONITOR_P), watcher, watched, ref); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(5); return res; } @@ -815,18 +858,17 @@ erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher, make_small(DOP_DEMONITOR_P), watcher, watched, ref); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, force); + res = dsig_send_ctl(dsdp, ctl, force); UnUseTmpHeapNoproc(5); return res; } int -erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) +erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,5); Eterm token = NIL; - Process *sender = dsdp->proc; + Process *sender = ctx->dsd.proc; int res; #ifdef USE_VM_PROBES Sint tok_label = 0; @@ -838,8 +880,7 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) DTRACE_CHARBUF(receiver_name, 64); #endif - UseTmpHeapNoproc(5); - if (SEQ_TRACE_TOKEN(sender) != NIL + if (SEQ_TRACE_TOKEN(sender) != NIL #ifdef USE_VM_PROBES && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag #endif @@ -852,7 +893,7 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", dsdp->dep->sysname); + "%T", ctx->dsd.dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -867,26 +908,28 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) #endif if (token != NIL) - ctl = TUPLE4(&ctl_heap[0], + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_SEND_TT), am_Cookie, remote, token); else - ctl = TUPLE3(&ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = dsig_send(dsdp, ctl, message, 0); - UnUseTmpHeapNoproc(5); + ctx->dss.ctl = ctl; + ctx->dss.msg = message; + ctx->dss.force_busy = 0; + res = erts_dsig_send(&ctx->dsd, &ctx->dss); return res; } int -erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) +erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, + ErtsSendContext* ctx) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,6); Eterm token = NIL; - Process *sender = dsdp->proc; + Process *sender = ctx->dsd.proc; int res; #ifdef USE_VM_PROBES Sint tok_label = 0; @@ -898,7 +941,6 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) DTRACE_CHARBUF(receiver_name, 128); #endif - UseTmpHeapNoproc(6); if (SEQ_TRACE_TOKEN(sender) != NIL #ifdef USE_VM_PROBES && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag @@ -912,7 +954,7 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", dsdp->dep->sysname); + "%T", ctx->dsd.dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -927,17 +969,19 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) #endif if (token != NIL) - ctl = TUPLE5(&ctl_heap[0], make_small(DOP_REG_SEND_TT), + ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT), sender->common.id, am_Cookie, remote_name, token); else - ctl = TUPLE4(&ctl_heap[0], make_small(DOP_REG_SEND), + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND), sender->common.id, am_Cookie, remote_name); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = dsig_send(dsdp, ctl, message, 0); - UnUseTmpHeapNoproc(6); + ctx->dss.ctl = ctl; + ctx->dss.msg = message; + ctx->dss.force_busy = 0; + res = erts_dsig_send(&ctx->dsd, &ctx->dss); return res; } @@ -994,7 +1038,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, DTRACE7(process_exit_signal_remote, sender_name, node_name, remote_name, reason_str, tok_label, tok_lastcnt, tok_serial); /* forced, i.e ignore busy */ - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(6); return res; } @@ -1010,7 +1054,7 @@ erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); /* forced, i.e ignore busy */ - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(5); return res; } @@ -1026,7 +1070,7 @@ erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT2), local, remote, reason); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(5); return res; } @@ -1043,7 +1087,7 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) ctl = TUPLE3(&ctl_heap[0], make_small(DOP_GROUP_LEADER), leader, remote); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -1693,194 +1737,235 @@ int erts_net_message(Port *prt, return -1; } -static int -dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) +static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy) { + struct erts_dsig_send_context ctx; + int ret; + ctx.ctl = ctl; + ctx.msg = THE_NON_VALUE; + ctx.force_busy = force_busy; + ctx.phase = ERTS_DSIG_SEND_PHASE_INIT; +#ifdef DEBUG + ctx.reds = 1; /* provoke assert below (no reduction count without msg) */ +#endif + ret = erts_dsig_send(dsdp, &ctx); + ASSERT(ret != ERTS_DSIG_SEND_CONTINUE); + return ret; +} + +int +erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) +{ + int retval; + Sint initial_reds = ctx->reds; Eterm cid; - int suspended = 0; - int resume = 0; - Uint32 pass_through_size; - Uint data_size, dhdr_ext_size; - ErtsAtomCacheMap *acmp; - ErtsDistOutputBuf *obuf; - DistEntry *dep = dsdp->dep; - Uint32 flags = dep->flags; - Process *c_p = dsdp->proc; - if (!c_p || dsdp->no_suspend) - force_busy = 1; + while (1) { + switch (ctx->phase) { + case ERTS_DSIG_SEND_PHASE_INIT: + ctx->flags = dsdp->dep->flags; + ctx->c_p = dsdp->proc; - ERTS_SMP_LC_ASSERT(!c_p - || (ERTS_PROC_LOCK_MAIN - == erts_proc_lc_my_proc_locks(c_p))); + if (!ctx->c_p || dsdp->no_suspend) + ctx->force_busy = 1; - if (!erts_is_alive) - return ERTS_DSIG_SEND_OK; + ERTS_SMP_LC_ASSERT(!ctx->c_p + || (ERTS_PROC_LOCK_MAIN + == erts_proc_lc_my_proc_locks(ctx->c_p))); - if (flags & DFLAG_DIST_HDR_ATOM_CACHE) { - acmp = erts_get_atom_cache_map(c_p); - pass_through_size = 0; - } - else { - acmp = NULL; - pass_through_size = 1; - } + if (!erts_is_alive) + return ERTS_DSIG_SEND_OK; -#ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, ">>%s CTL: %T\n", pass_through_size ? "P" : " ", ctl); - if (is_value(msg)) - erts_fprintf(stderr, " MSG: %T\n", msg); -#endif + if (ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE) { + ctx->acmp = erts_get_atom_cache_map(ctx->c_p); + ctx->pass_through_size = 0; + } + else { + ctx->acmp = NULL; + ctx->pass_through_size = 1; + } - data_size = pass_through_size; - erts_reset_atom_cache_map(acmp); - data_size += erts_encode_dist_ext_size(ctl, flags, acmp); - if (is_value(msg)) - data_size += erts_encode_dist_ext_size(msg, flags, acmp); - erts_finalize_atom_cache_map(acmp, flags); + #ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, ">>%s CTL: %T\n", ctx->pass_through_size ? "P" : " ", ctx->ctl); + if (is_value(msg)) + erts_fprintf(stderr, " MSG: %T\n", msg); + #endif + + ctx->data_size = ctx->pass_through_size; + erts_reset_atom_cache_map(ctx->acmp); + erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size); + + if (is_value(ctx->msg)) { + 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; + } else { + ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + } + break; - dhdr_ext_size = erts_encode_ext_dist_header_size(acmp); - data_size += dhdr_ext_size; + case ERTS_DSIG_SEND_PHASE_MSG_SIZE: + if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } - obuf = alloc_dist_obuf(data_size); - obuf->ext_endp = &obuf->data[0] + pass_through_size + dhdr_ext_size; + ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + case ERTS_DSIG_SEND_PHASE_ALLOC: + erts_finalize_atom_cache_map(ctx->acmp, ctx->flags); + + ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp); + ctx->data_size += ctx->dhdr_ext_size; + + ctx->obuf = alloc_dist_obuf(ctx->data_size); + ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->pass_through_size + ctx->dhdr_ext_size; + + /* Encode internal version of dist header */ + ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp); + /* Encode control message */ + erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL); + if (is_value(ctx->msg)) { + ctx->u.ec.flags = ctx->flags; + ctx->u.ec.level = 0; + ctx->u.ec.wstack.wstart = NULL; + ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE; + } else { + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + } + break; - /* Encode internal version of dist header */ - obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp); - /* Encode control message */ - erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp); - if (is_value(msg)) { - /* Encode message */ - erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp); - } + case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: + if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } - ASSERT(obuf->extp < obuf->ext_endp); - ASSERT(&obuf->data[0] <= obuf->extp - pass_through_size); - ASSERT(obuf->ext_endp <= &obuf->data[0] + data_size); + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + case ERTS_DSIG_SEND_PHASE_FIN: { + DistEntry *dep = dsdp->dep; + int suspended = 0; + int resume = 0; - data_size = obuf->ext_endp - obuf->extp; + ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp); + ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->pass_through_size); + ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size); - /* - * Signal encoded; now verify that the connection still exists, - * and if so enqueue the signal and schedule it for send. - */ - obuf->next = NULL; - erts_smp_de_rlock(dep); - cid = dep->cid; - if (cid != dsdp->cid - || dep->connection_id != dsdp->connection_id - || dep->status & ERTS_DE_SFLG_EXITING) { - /* Not the same connection as when we started; drop message... */ - erts_smp_de_runlock(dep); - free_dist_obuf(obuf); - } - else { - ErtsProcList *plp = NULL; - erts_smp_mtx_lock(&dep->qlock); - dep->qsize += size_obuf(obuf); - if (dep->qsize >= erts_dist_buf_busy_limit) - dep->qflgs |= ERTS_DE_QFLG_BUSY; - if (!force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { - erts_smp_mtx_unlock(&dep->qlock); + ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; - plp = erts_proclist_create(c_p); - erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); - suspended = 1; - erts_smp_mtx_lock(&dep->qlock); - } + /* + * Signal encoded; now verify that the connection still exists, + * and if so enqueue the signal and schedule it for send. + */ + ctx->obuf->next = NULL; + erts_smp_de_rlock(dep); + cid = dep->cid; + if (cid != dsdp->cid + || dep->connection_id != dsdp->connection_id + || dep->status & ERTS_DE_SFLG_EXITING) { + /* Not the same connection as when we started; drop message... */ + erts_smp_de_runlock(dep); + free_dist_obuf(ctx->obuf); + } + else { + ErtsProcList *plp = NULL; + erts_smp_mtx_lock(&dep->qlock); + dep->qsize += size_obuf(ctx->obuf); + if (dep->qsize >= erts_dist_buf_busy_limit) + dep->qflgs |= ERTS_DE_QFLG_BUSY; + if (!ctx->force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { + erts_smp_mtx_unlock(&dep->qlock); + + plp = erts_proclist_create(ctx->c_p); + erts_suspend(ctx->c_p, ERTS_PROC_LOCK_MAIN, NULL); + suspended = 1; + erts_smp_mtx_lock(&dep->qlock); + } - /* Enqueue obuf on dist entry */ - if (dep->out_queue.last) - dep->out_queue.last->next = obuf; - else - dep->out_queue.first = obuf; - dep->out_queue.last = obuf; + /* Enqueue obuf on dist entry */ + if (dep->out_queue.last) + dep->out_queue.last->next = ctx->obuf; + else + dep->out_queue.first = ctx->obuf; + dep->out_queue.last = ctx->obuf; + + if (!ctx->force_busy) { + if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { + if (suspended) + resume = 1; /* was busy when we started, but isn't now */ + #ifdef USE_VM_PROBES + if (resume && DTRACE_ENABLED(dist_port_not_busy)) { + DTRACE_CHARBUF(port_str, 64); + DTRACE_CHARBUF(remote_str, 64); + + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), + "%T", dep->sysname); + DTRACE3(dist_port_not_busy, erts_this_node_sysname, + port_str, remote_str); + } + #endif + } + else { + /* Enqueue suspended process on dist entry */ + ASSERT(plp); + erts_proclist_store_last(&dep->suspended, plp); + } + } - if (!force_busy) { - if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { - if (suspended) - resume = 1; /* was busy when we started, but isn't now */ -#ifdef USE_VM_PROBES - if (resume && DTRACE_ENABLED(dist_port_not_busy)) { - DTRACE_CHARBUF(port_str, 64); - DTRACE_CHARBUF(remote_str, 64); - - erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), - "%T", cid); - erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), - "%T", dep->sysname); - DTRACE3(dist_port_not_busy, erts_this_node_sysname, - port_str, remote_str); - } -#endif + erts_smp_mtx_unlock(&dep->qlock); + erts_schedule_dist_command(NULL, dep); + erts_smp_de_runlock(dep); + + if (resume) { + erts_resume(ctx->c_p, ERTS_PROC_LOCK_MAIN); + erts_proclist_destroy(plp); + /* + * Note that the calling process still have to yield as if it + * suspended. If not, the calling process could later be + * erroneously scheduled when it shouldn't be. + */ + } } - else { - /* Enqueue suspended process on dist entry */ - ASSERT(plp); - erts_proclist_store_last(&dep->suspended, plp); + ctx->obuf = NULL; + + if (suspended) { + #ifdef USE_VM_PROBES + if (!resume && DTRACE_ENABLED(dist_port_busy)) { + DTRACE_CHARBUF(port_str, 64); + DTRACE_CHARBUF(remote_str, 64); + DTRACE_CHARBUF(pid_str, 16); + + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), + "%T", dep->sysname); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), + "%T", ctx->c_p->common.id); + DTRACE4(dist_port_busy, erts_this_node_sysname, + port_str, remote_str, pid_str); + } + #endif + if (!resume && erts_system_monitor_flags.busy_dist_port) + monitor_generic(ctx->c_p, am_busy_dist_port, cid); + retval = ERTS_DSIG_SEND_YIELD; + } else { + retval = ERTS_DSIG_SEND_OK; } + goto done; } - - erts_smp_mtx_unlock(&dep->qlock); - erts_schedule_dist_command(NULL, dep); - erts_smp_de_runlock(dep); - - if (resume) { - erts_resume(c_p, ERTS_PROC_LOCK_MAIN); - erts_proclist_destroy(plp); - /* - * Note that the calling process still have to yield as if it - * suspended. If not, the calling process could later be - * erroneously scheduled when it shouldn't be. - */ + default: + erl_exit(ERTS_ABORT_EXIT, "dsig_send invalid phase (%d)\n", (int)ctx->phase); } } - if (c_p) { - int reds; - /* - * Bump reductions on calling process. - * - * This is the reduction cost: Always a base cost of 8 reductions - * plus 16 reductions per kilobyte generated external data. - */ - - data_size >>= (10-4); -#if defined(ARCH_64) && !HALFWORD_HEAP - data_size &= 0x003fffffffffffff; -#elif defined(ARCH_32) || HALFWORD_HEAP - data_size &= 0x003fffff; -#else -# error "Ohh come on ... !?!" -#endif - reds = 8 + ((int) data_size > 1000000 ? 1000000 : (int) data_size); - BUMP_REDS(c_p, reds); - } - - if (suspended) { -#ifdef USE_VM_PROBES - if (!resume && DTRACE_ENABLED(dist_port_busy)) { - DTRACE_CHARBUF(port_str, 64); - DTRACE_CHARBUF(remote_str, 64); - DTRACE_CHARBUF(pid_str, 16); - - erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid); - erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), - "%T", dep->sysname); - erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), - "%T", c_p->common.id); - DTRACE4(dist_port_busy, erts_this_node_sysname, - port_str, remote_str, pid_str); - } -#endif - if (!resume && erts_system_monitor_flags.busy_dist_port) - monitor_generic(c_p, am_busy_dist_port, cid); - return ERTS_DSIG_SEND_YIELD; +done: + if (ctx->msg && ctx->c_p) { + BUMP_REDS(ctx->c_p, (initial_reds - ctx->reds) / TERM_TO_BINARY_LOOP_FACTOR); } - return ERTS_DSIG_SEND_OK; + return retval; } - static Uint dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) { @@ -3236,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 f32b999198..cd2cc0ef4a 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -22,6 +22,7 @@ #include "erl_process.h" #include "erl_node_tables.h" +#include "zlib.h" #define DFLAG_PUBLISHED 0x01 #define DFLAG_ATOM_CACHE 0x02 @@ -264,17 +265,105 @@ erts_destroy_dist_link(ErtsDistLinkData *dldp) #endif + + +/* Define for testing */ +/* #define EXTREME_TTB_TRAPPING 1 */ + +#ifndef EXTREME_TTB_TRAPPING +#define TERM_TO_BINARY_LOOP_FACTOR 32 +#else +#define TERM_TO_BINARY_LOOP_FACTOR 1 +#endif + +typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; +typedef struct TTBSizeContext_ { + Uint flags; + int level; + Uint result; + Eterm obj; + ErtsWStack wstack; +} TTBSizeContext; + +typedef struct TTBEncodeContext_ { + Uint flags; + int level; + byte* ep; + Eterm obj; + ErtsWStack wstack; + Binary *result_bin; +} TTBEncodeContext; + +typedef struct { + Uint real_size; + Uint dest_len; + byte *dbytes; + Binary *result_bin; + Binary *destination_bin; + z_stream stream; +} TTBCompressContext; + +typedef struct { + int alive; + TTBState state; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + TTBCompressContext cc; + } s; +} TTBContext; + +enum erts_dsig_send_phase { + ERTS_DSIG_SEND_PHASE_INIT, + ERTS_DSIG_SEND_PHASE_MSG_SIZE, + ERTS_DSIG_SEND_PHASE_ALLOC, + ERTS_DSIG_SEND_PHASE_MSG_ENCODE, + ERTS_DSIG_SEND_PHASE_FIN +}; + +struct erts_dsig_send_context { + enum erts_dsig_send_phase phase; + Sint reds; + + Eterm ctl; + Eterm msg; + int force_busy; + Uint32 pass_through_size; + Uint data_size, dhdr_ext_size; + ErtsAtomCacheMap *acmp; + ErtsDistOutputBuf *obuf; + Uint32 flags; + Process *c_p; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + }u; +}; + +typedef struct { + int suspend; + + Eterm ctl_heap[6]; + ErtsDSigData dsd; + DistEntry* dep_to_deref; + struct erts_dsig_send_context dss; + + Eterm return_term; +}ErtsSendContext; + + /* * erts_dsig_send_* return values. */ #define ERTS_DSIG_SEND_OK 0 #define ERTS_DSIG_SEND_YIELD 1 +#define ERTS_DSIG_SEND_CONTINUE 2 extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*); extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_reg_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_reg_msg(Eterm, Eterm, ErtsSendContext*); extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm); extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm); extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm); @@ -282,6 +371,10 @@ extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int); extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm); extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); +extern int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx); +extern void erts_dsend_context_dtor(Binary*); +extern Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx); + extern int erts_dist_command(Port *prt, int reds); extern void erts_dist_port_not_busy(Port *prt); extern void erts_kill_dist_connection(DistEntry *dep, Uint32); diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 90cd227fae..dcae5509ec 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -39,7 +39,7 @@ #include "erl_instrument.h" #include "erl_mseg.h" #include "erl_monitors.h" -#include "erl_bif_timer.h" +#include "erl_hl_timer.h" #include "erl_cpu_topology.h" #include "erl_thr_queue.h" #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) @@ -575,6 +575,15 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)] = sizeof(ErtsThrQElement_t); #endif + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_LL_PTIMER)] + = erts_timer_type_size(ERTS_ALC_T_LL_PTIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_HL_PTIMER)] + = erts_timer_type_size(ERTS_ALC_T_HL_PTIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_BIF_TIMER)] + = erts_timer_type_size(ERTS_ALC_T_BIF_TIMER); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_ABIF_TIMER)] + = erts_timer_type_size(ERTS_ALC_T_ABIF_TIMER); + #ifdef HARD_DEBUG hdbg_init(); #endif @@ -2322,6 +2331,22 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_MSG_REF); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_LL_PTIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_HL_PTIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_BIF_TIMER); + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_ABIF_TIMER); } if (want.atom || want.atom_used) { @@ -3180,17 +3205,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 +3285,7 @@ erts_request_alloc_info(struct process *c_p, erts_smp_atomic32_init_nob(&air->refc, (erts_aint32_t) erts_no_schedulers); - erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + erts_proc_add_refc(c_p, (Sint) erts_no_schedulers); #ifdef ERTS_SMP if (erts_no_schedulers > 1) @@ -3939,7 +3960,7 @@ static Uint install_debug_functions(void) { int i; - ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs)); diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 21434eb117..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 @@ -415,6 +418,13 @@ type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path 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_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index e3172dc4fb..b92533f228 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -718,7 +718,7 @@ static void make_name_atoms(Allctr_t *allctr); static Block_t *create_carrier(Allctr_t *, Uint, UWord); static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **); static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp); -static void dealloc_block(Allctr_t *, void *, int); +static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int); /* internal data... */ @@ -1067,17 +1067,21 @@ typedef struct { } ErtsAllctrFixDDBlock_t; #endif +#define ERTS_ALC_FIX_NO_UNUSE (((ErtsAlcType_t) 1) << ERTS_ALC_N_BITS) + static ERTS_INLINE void dealloc_fix_block(Allctr_t *allctr, ErtsAlcType_t type, void *ptr, + ErtsAlcFixList_t *fix, int dec_cc_on_redirect) { #ifdef ERTS_SMP /* May be redirected... */ - ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type; + ASSERT((type & ERTS_ALC_FIX_NO_UNUSE) == 0); + ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type | ERTS_ALC_FIX_NO_UNUSE; #endif - dealloc_block(allctr, ptr, dec_cc_on_redirect); + dealloc_block(allctr, ptr, fix, dec_cc_on_redirect); } static ERTS_INLINE void @@ -1123,8 +1127,7 @@ fix_cpool_check_shrink(Allctr_t *allctr, if (fix->u.cpool.min_list_size > fix->list_size) fix->u.cpool.min_list_size = fix->list_size; - fix->u.cpool.allocated--; - dealloc_fix_block(allctr, type, p, 0); + dealloc_fix_block(allctr, type, p, fix, 0); } } } @@ -1170,7 +1173,8 @@ static ERTS_INLINE void fix_cpool_free(Allctr_t *allctr, ErtsAlcType_t type, void *p, - Carrier_t **busy_pcrr_pp) + Carrier_t **busy_pcrr_pp, + int unuse) { ErtsAlcFixList_t *fix; @@ -1178,8 +1182,9 @@ fix_cpool_free(Allctr_t *allctr, && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; - - fix->u.cpool.used--; + + if (unuse) + fix->u.cpool.used--; if ((!busy_pcrr_pp || !*busy_pcrr_pp) && !fix->u.cpool.shrink_list @@ -1237,8 +1242,7 @@ fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) fix->list = *((void **) ptr); fix->list_size--; fix->u.cpool.shrink_list--; - fix->u.cpool.allocated--; - dealloc_fix_block(allctr, type, ptr, 0); + dealloc_fix_block(allctr, type, ptr, fix, 0); } if (fix->u.cpool.min_list_size > fix->list_size) fix->u.cpool.min_list_size = fix->list_size; @@ -1399,7 +1403,7 @@ fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) ptr = fix->list; fix->list = *((void **) ptr); fix->list_size--; - dealloc_block(allctr, ptr, 0); + dealloc_block(allctr, ptr, NULL, 0); fix->u.nocpool.allocated--; } if (fix->list_size != 0) { @@ -1442,7 +1446,7 @@ get_pref_allctr(void *extra) pref_ix = ERTS_ALC_GET_THR_IX(); - ASSERT(sizeof(UWord) == sizeof(Allctr_t *)); + ERTS_CT_ASSERT(sizeof(UWord) == sizeof(Allctr_t *)); ASSERT(0 <= pref_ix && pref_ix < tspec->size); return tspec->allctr[pref_ix]; @@ -1746,11 +1750,13 @@ handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr) type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type; - ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type - && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE + <= (type & ~ERTS_ALC_FIX_NO_UNUSE)); + ASSERT((type & ~ERTS_ALC_FIX_NO_UNUSE) + <= ERTS_ALC_N_MAX_A_FIXED_SIZE); if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) - fix_nocpool_free(allctr, type, ptr); + fix_nocpool_free(allctr, (type & ~ERTS_ALC_FIX_NO_UNUSE), ptr); else { Block_t *blk = UMEM2BLK(ptr); Carrier_t *busy_pcrr_p; @@ -1765,7 +1771,9 @@ handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr) NULL, &busy_pcrr_p); if (used_allctr == allctr) { doit: - fix_cpool_free(allctr, type, ptr, &busy_pcrr_p); + fix_cpool_free(allctr, (type & ~ERTS_ALC_FIX_NO_UNUSE), + ptr, &busy_pcrr_p, + !(type & ERTS_ALC_FIX_NO_UNUSE)); clear_busy_pool_carrier(allctr, busy_pcrr_p); } else { @@ -1861,7 +1869,7 @@ handle_delayed_dealloc(Allctr_t *allctr, * if this carrier is pulled from dc_list by cpool_fetch() */ ERTS_ALC_CPOOL_ASSERT(FBLK_TO_MBC(blk) != crr); - ERTS_ALC_CPOOL_ASSERT(sizeof(ErtsAllctrDDBlock_t) == sizeof(void*)); + ERTS_CT_ASSERT(sizeof(ErtsAllctrDDBlock_t) == sizeof(void*)); #ifdef MBC_ABLK_OFFSET_BITS blk->u.carrier = crr; #else @@ -1885,7 +1893,7 @@ handle_delayed_dealloc(Allctr_t *allctr, if (fix) handle_delayed_fix_dealloc(allctr, ptr); else - dealloc_block(allctr, ptr, 1); + dealloc_block(allctr, ptr, NULL, 1); } } @@ -1991,15 +1999,24 @@ erts_alcu_check_delayed_dealloc(Allctr_t *allctr, ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL, NULL) static void -dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect) +dealloc_block(Allctr_t *allctr, void *ptr, ErtsAlcFixList_t *fix, int dec_cc_on_redirect) { Block_t *blk = UMEM2BLK(ptr); ERTS_SMP_LC_ASSERT(!allctr->thread_safe || erts_lc_mtx_is_locked(&allctr->mutex)); - if (IS_SBC_BLK(blk)) + if (IS_SBC_BLK(blk)) { destroy_carrier(allctr, blk, NULL); +#ifdef ERTS_SMP + if (fix && ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + ErtsAlcType_t type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type; + if (!(type & ERTS_ALC_FIX_NO_UNUSE)) + fix->u.cpool.used--; + fix->u.cpool.allocated--; + } +#endif + } #ifndef ERTS_SMP else mbc_free(allctr, ptr, NULL); @@ -2012,6 +2029,12 @@ dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect) used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr, NULL, &busy_pcrr_p); if (used_allctr == allctr) { + if (fix) { + ErtsAlcType_t type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type; + if (!(type & ERTS_ALC_FIX_NO_UNUSE)) + fix->u.cpool.used--; + fix->u.cpool.allocated--; + } mbc_free(allctr, ptr, &busy_pcrr_p); clear_busy_pool_carrier(allctr, busy_pcrr_p); } @@ -5215,7 +5238,7 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p, if (allctr->fix) { if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) - fix_cpool_free(allctr, type, p, busy_pcrr_pp); + fix_cpool_free(allctr, type, p, busy_pcrr_pp, 1); else fix_nocpool_free(allctr, type, p); } @@ -5942,7 +5965,7 @@ erts_alcu_init(AlcUInit_t *init) erts_atomic_init_nob(&sentinel->prev, (erts_aint_t) sentinel); } #endif - ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */ + ERTS_CT_ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */ #if HAVE_ERTS_MSEG ASSERT(erts_mseg_unit_size() == ERTS_SACRR_UNIT_SZ); max_mseg_carriers = init->mmc; 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_async.c b/erts/emulator/beam/erl_async.c index decae6b2ca..bc06d41720 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -176,7 +176,7 @@ erts_init_async(void) ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; #endif erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; - char *ptr; + char *ptr, thr_name[16]; size_t tot_size = 0; int i; @@ -227,23 +227,16 @@ erts_init_async(void) thr_opts.suggested_stack_size = erts_async_thread_suggested_stack_size; -#ifdef ETHR_HAVE_THREAD_NAMES - thr_opts.name = malloc(sizeof(char)*(strlen("async_XXXX")+1)); -#endif + thr_opts.name = thr_name; for (i = 0; i < erts_async_max_threads; i++) { ErtsAsyncQ *aq = async_q(i); -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(thr_opts.name, "async_%d", i+1); -#endif + erts_snprintf(thr_opts.name, 16, "async_%d", i+1); erts_thr_create(&aq->thr_id, async_main, (void*) aq, &thr_opts); } -#ifdef ETHR_HAVE_THREAD_NAMES - free(thr_opts.name); -#endif /* Wait for async threads to initialize... */ erts_mtx_lock(&async->init.data.mtx); diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 3bf78adce7..934904d58e 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -32,10 +32,13 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" +#include "erl_bif_unique.h" /* @@ -2424,8 +2427,6 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) } cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap if trapping */ - cbs->result->flags = 0; - cbs->result->orig_size = target_size; erts_refc_init(&(cbs->result->refc), 1); t = (byte *) cbs->result->orig_bytes; /* No offset or anything */ pos = 0; 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 b90362d82c..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 @@ -116,6 +117,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_ENABLE_LOCK_COUNT " [lock-counting]" #endif +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + " [instruction-counting]" +#endif #ifdef PURIFY " [purify-compiled]" #endif @@ -537,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: @@ -589,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))) @@ -1049,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; @@ -2099,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); @@ -2301,7 +2350,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) for (i = num_instructions-1; i >= 0; i--) { res = erts_bld_cons(hpp, hszp, erts_bld_tuple(hpp, hszp, 2, - erts_atom_put(opc[i].name, + erts_atom_put((byte *)opc[i].name, strlen(opc[i].name), ERTS_ATOM_ENC_LATIN1, 1), @@ -2700,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); @@ -3400,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); @@ -3594,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: @@ -3603,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) { @@ -3897,6 +4055,13 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } } } + else if (ERTS_IS_ATOM_STR("broken_halt", BIF_ARG_1)) { + 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 06fbbea123..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 */ @@ -651,7 +652,7 @@ Eterm trace_3(BIF_ALIST_3) if (pid_spec == am_all) { if (on) { if (!erts_cpu_timestamp) { -#ifdef HAVE_CLOCK_GETTIME +#ifdef HAVE_CLOCK_GETTIME_CPU_TIME /* Perhaps clock_gettime was found during config on a different machine than this. We check @@ -678,7 +679,7 @@ Eterm trace_3(BIF_ALIST_3) if (erts_start_now_cpu() < 0) { goto error; } -#endif /* HAVE_CLOCK_GETTIME */ +#endif /* HAVE_CLOCK_GETTIME_CPU_TIME */ erts_cpu_timestamp = !0; } } 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_binary.h b/erts/emulator/beam/erl_binary.h index 06dfeb1260..8d264d166e 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -231,41 +231,58 @@ erts_free_aligned_binary_bytes(byte* buf) # define CHICKEN_PAD (sizeof(void*) - 1) #endif +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc_fnf(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ return NULL; res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + if (res) { + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + } + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size); res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_nrml_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_BINARY, size); res = erts_alloc(ERTS_ALC_T_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = 0; + return res; } ERTS_GLB_INLINE Binary * @@ -280,6 +297,8 @@ erts_bin_realloc_fnf(Binary *bp, Uint size) return NULL; nbp = erts_realloc_fnf(type, (void *) bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + if (nbp) + nbp->orig_size = size; return nbp; } @@ -297,6 +316,7 @@ erts_bin_realloc(Binary *bp, Uint size) if (!nbp) erts_realloc_enomem(type, bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + nbp->orig_size = size; return nbp; } @@ -329,4 +349,4 @@ erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#endif +#endif /* !__ERL_BINARY_H */ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 53c21c40e1..b8ae93fa58 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -165,6 +165,26 @@ erts_bs_start_match_2(Process *p, Eterm Binary, Uint Max) return make_matchstate(ms); } +#ifdef DEBUG +# define CHECK_MATCH_BUFFER(MB) check_match_buffer(MB) + +static void check_match_buffer(ErlBinMatchBuffer* mb) +{ + Eterm realbin; + Uint byteoffs; + byte* bytes, bitoffs, bitsz; + ProcBin* pb; + ERTS_GET_REAL_BIN(mb->orig, realbin, byteoffs, bitoffs, bitsz); + bytes = binary_bytes(realbin) + byteoffs; + ERTS_ASSERT(mb->base >= bytes && mb->base <= (bytes + binary_size(mb->orig))); + pb = (ProcBin *) boxed_val(realbin); + if (pb->thing_word == HEADER_PROC_BIN) + ERTS_ASSERT(pb->flags == 0); +} +#else +# define CHECK_MATCH_BUFFER(MB) +#endif + Eterm erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) { @@ -185,6 +205,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff return SMALL_ZERO; } + CHECK_MATCH_BUFFER(mb); if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ return THE_NON_VALUE; } @@ -425,6 +446,7 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe { ErlSubBin* sb; + CHECK_MATCH_BUFFER(mb); if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ return THE_NON_VALUE; } @@ -456,6 +478,7 @@ erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer byte* fptr; FloatDef f; + CHECK_MATCH_BUFFER(mb); if (num_bits == 0) { f.fd = 0.0; hp = HeapOnlyAlloc(p, FLOAT_SIZE_OBJECT); @@ -509,6 +532,8 @@ erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb) { ErlSubBin* sb; Uint size; + + CHECK_MATCH_BUFFER(mb); size = mb->size-mb->offset; sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE); sb->thing_word = HEADER_SUB_BIN; @@ -1302,7 +1327,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, if (binp->orig_size < pb->size) { Uint new_size = 2*pb->size; binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } @@ -1374,8 +1398,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -1478,7 +1500,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * is safe to reallocate it. */ binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } else { @@ -1491,8 +1512,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * binary and copy the contents of the old binary into it. */ Binary* bptr = erts_bin_nrml_alloc(new_size); - bptr->flags = 0; - bptr->orig_size = new_size; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, binp->orig_bytes, binp->orig_size); pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER; @@ -1540,8 +1559,6 @@ erts_bs_init_writable(Process* p, Eterm sz) * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); /* @@ -1588,9 +1605,7 @@ erts_emasculate_writable_binary(ProcBin* pb) /* Our allocators are 8 byte aligned, i.e., shrinking with less than 8 bytes will have no real effect */ if (unused >= 8) { - Uint new_size = pb->size; binp = erts_bin_realloc(binp, pb->size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } @@ -1605,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); @@ -1664,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; } @@ -1748,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 8f246ffa07..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; @@ -753,6 +753,31 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2) BIF_RET(ret); } +/* +** take(Tab, Key) +*/ +BIF_RETTYPE ets_take_2(BIF_ALIST_2) +{ + DbTable* tb; +#ifdef DEBUG + int cret; +#endif + Eterm ret; + CHECK_TABLES(); + + tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC); + if (!tb) { + BIF_ERROR(BIF_P, BADARG); + } +#ifdef DEBUG + cret = +#endif + tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret); + ASSERT(cret == DB_ERROR_NONE); + db_unlock(tb, LCK_WRITE_REC); + BIF_RET(ret); +} + /* ** update_element(Tab, Key, {Pos, Value}) ** update_element(Tab, Key, [{Pos, Value}]) @@ -780,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; } @@ -819,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); @@ -838,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; @@ -855,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 */ @@ -863,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 */ } @@ -957,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; @@ -1010,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 */ @@ -1199,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 @@ -1515,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", @@ -1648,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(); @@ -2643,7 +2691,9 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) BIF_RETTYPE ets_info_1(BIF_ALIST_1) { static Eterm fields[] = {am_protection, am_keypos, am_type, am_named_table, - am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed}; + am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed, + am_write_concurrency, + am_read_concurrency}; Eterm results[sizeof(fields)/sizeof(Eterm)]; DbTable* tb; Eterm res; @@ -3670,6 +3720,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) ret = am_protected; else if (tb->common.status & DB_PUBLIC) ret = am_public; + } else if (What == am_write_concurrency) { + ret = tb->common.status & DB_FINE_LOCKED ? am_true : am_false; + } else if (What == am_read_concurrency) { + ret = tb->common.status & DB_FREQ_READ ? am_true : am_false; } else if (What == am_name) { ret = tb->common.the_name; } else if (What == am_keypos) { @@ -3752,7 +3806,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) avg, std_dev_real, std_dev_exp, make_small(stats.min_chain_len), make_small(stats.max_chain_len), - make_small(db_kept_items_hash(&tb->hash))); + make_small(stats.kept_items)); } else { ret = am_false; @@ -3774,6 +3828,11 @@ static void print_table(int to, void *to_arg, int show, DbTable* tb) + sizeof(Uint) - 1) / sizeof(Uint))); + erts_print(to, to_arg, "Type: %T\n", table_info(NULL, tb, am_type)); + erts_print(to, to_arg, "Protection: %T\n", table_info(NULL, tb, am_protection)); + erts_print(to, to_arg, "Compressed: %T\n", table_info(NULL, tb, am_compressed)); + erts_print(to, to_arg, "Write Concurrency: %T\n", table_info(NULL, tb, am_write_concurrency)); + erts_print(to, to_arg, "Read Concurrency: %T\n", table_info(NULL, tb, am_read_concurrency)); } void db_info(int to, void *to_arg, int show) /* Called by break handler */ diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 06dac8f161..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) @@ -382,7 +382,7 @@ static HashDbTerm* search_list(DbTableHash* tb, Eterm key, static void shrink(DbTableHash* tb, int nactive); static void grow(DbTableHash* tb, int nactive); static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, - DbTableHash*); + Uint sz, DbTableHash*); static int analyze_pattern(DbTableHash *tb, Eterm pattern, struct mp_info *mpi); @@ -426,6 +426,7 @@ static int db_select_count_continue_hash(Process *p, DbTable *tbl, static int db_select_delete_continue_hash(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); +static int db_take_hash(Process *, DbTable *, Eterm, Eterm *); static void db_print_hash(int to, void *to_arg, int show, @@ -443,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) { @@ -536,6 +540,7 @@ DbTableMethod db_hash = db_select_delete_continue_hash, db_select_count_hash, db_select_count_continue_hash, + db_take_hash, db_delete_all_objects_hash, db_free_table_hash, db_free_table_continue_hash, @@ -646,25 +651,6 @@ restart: /* ToDo: Maybe try grow/shrink the table as well */ } -/* Only used by tests -*/ -Uint db_kept_items_hash(DbTableHash *tb) -{ - Uint kept_items = 0; - Uint ix = 0; - erts_smp_rwmtx_t* lck = RLOCK_HASH(tb,ix); - HashDbTerm* b; - do { - for (b = BUCKET(tb, ix); b != NULL; b = b->next) { - if (b->hvalue == INVALID_HASH) { - ++kept_items; - } - } - ix = next_slot(tb, ix, &lck); - }while (ix); - return kept_items; -} - int db_create_hash(Process *p, DbTable *tbl) { DbTableHash *tb = &tbl->hash; @@ -879,34 +865,49 @@ Ldone: return ret; } +static Eterm +get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval, + HashDbTerm *b1, HashDbTerm **bend) +{ + HashDbTerm* b2 = b1->next; + Eterm copy; + Uint sz = b1->dbterm.size + 2; + + if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { + while (b2 && has_key(tb, b2, key, hval)) { + if (b2->hvalue != INVALID_HASH) + sz += b2->dbterm.size + 2; + + b2 = b2->next; + } + } + copy = build_term_list(p, b1, b2, sz, tb); + CHECK_TABLES(); + if (bend) { + *bend = b2; + } + return copy; +} + int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTableHash *tb = &tbl->hash; HashValue hval; int ix; - HashDbTerm* b1; + HashDbTerm* b; erts_smp_rwmtx_t* lck; hval = MAKE_HASH(key); lck = RLOCK_HASH(tb,hval); ix = hash_to_ix(tb, hval); - b1 = BUCKET(tb, ix); - - while(b1 != 0) { - if (has_live_key(tb,b1,key,hval)) { - HashDbTerm* b2 = b1->next; - Eterm copy; + b = BUCKET(tb, ix); - if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { - while(b2 != NULL && has_key(tb,b2,key,hval)) - b2 = b2->next; - } - copy = build_term_list(p, b1, b2, tb); - CHECK_TABLES(); - *ret = copy; + while(b != 0) { + if (has_live_key(tb, b, key, hval)) { + *ret = get_term_list(p, tb, key, hval, b, NULL); goto done; } - b1 = b1->next; + b = b->next; } *ret = NIL; done: @@ -1240,7 +1241,7 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) lck = RLOCK_HASH(tb, slot); nactive = NACTIVE(tb); if (slot < nactive) { - *ret = build_term_list(p, BUCKET(tb, slot), 0, tb); + *ret = build_term_list(p, BUCKET(tb, slot), NULL, 0, tb); retval = DB_ERROR_NONE; } else if (slot == nactive) { @@ -2069,6 +2070,46 @@ trap: } +static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashDbTerm **bp, *b; + HashValue hval = MAKE_HASH(key); + erts_smp_rwmtx_t *lck = WLOCK_HASH(tb, hval); + int ix = hash_to_ix(tb, hval); + int nitems_diff = 0; + + *ret = NIL; + for (bp = &BUCKET(tb, ix), b = *bp; b; bp = &b->next, b = b->next) { + if (has_live_key(tb, b, key, hval)) { + HashDbTerm *bend; + + *ret = get_term_list(p, tb, key, hval, b, &bend); + while (b != bend) { + --nitems_diff; + if (nitems_diff == -1 && IS_FIXED(tb)) { + /* Pseudo remove (no need to keep several of same key) */ + add_fixed_deletion(tb, ix); + bp = &b->next; + b->hvalue = INVALID_HASH; + b = b->next; + } else { + *bp = b->next; + free_term(tb, b); + b = *bp; + } + } + break; + } + } + WUNLOCK_HASH(lck); + if (nitems_diff) { + erts_smp_atomic_add_nob(&tb->common.nitems, nitems_diff); + try_shrink(tb); + } + return DB_ERROR_NONE; +} + /* ** Other interface routines (not directly coupled to one bif) */ @@ -2104,10 +2145,38 @@ int db_mark_all_deleted_hash(DbTable *tbl) static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl) { DbTableHash *tb = &tbl->hash; + DbHashStats stats; int i; erts_print(to, to_arg, "Buckets: %d\n", NACTIVE(tb)); - + +#ifdef ERTS_SMP + i = tbl->common.is_thread_safe; + /* If crash dumping we set table to thread safe in order to + avoid taking any locks */ + if (ERTS_IS_CRASH_DUMPING) + tbl->common.is_thread_safe = 1; + + db_calc_stats_hash(&tbl->hash, &stats); + + tbl->common.is_thread_safe = i; +#else + db_calc_stats_hash(&tbl->hash, &stats); +#endif + + erts_print(to, to_arg, "Chain Length Avg: %f\n", stats.avg_chain_len); + erts_print(to, to_arg, "Chain Length Max: %d\n", stats.max_chain_len); + erts_print(to, to_arg, "Chain Length Min: %d\n", stats.min_chain_len); + erts_print(to, to_arg, "Chain Length Std Dev: %f\n", + stats.std_dev_chain_len); + erts_print(to, to_arg, "Chain Length Expected Std Dev: %f\n", + stats.std_dev_expected); + + if (IS_FIXED(tb)) + erts_print(to, to_arg, "Fixed: %d\n", stats.kept_items); + else + erts_print(to, to_arg, "Fixed: false\n"); + if (show) { for (i = 0; i < NACTIVE(tb); i++) { HashDbTerm* list = BUCKET(tb,i); @@ -2402,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); @@ -2468,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); } @@ -2483,23 +2552,23 @@ static int free_seg(DbTableHash *tb, int free_records) ** Copy terms from ptr1 until ptr2 ** works for ptr1 == ptr2 == 0 => [] ** or ptr2 == 0 +** sz is either precalculated heap size or 0 if not known */ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, - DbTableHash* tb) + Uint sz, DbTableHash* tb) { - int sz = 0; HashDbTerm* ptr; Eterm list = NIL; Eterm copy; Eterm *hp, *hend; - ptr = ptr1; - while(ptr != ptr2) { - - if (ptr->hvalue != INVALID_HASH) - sz += ptr->dbterm.size + 2; - - ptr = ptr->next; + if (!sz) { + ptr = ptr1; + while(ptr != ptr2) { + if (ptr->hvalue != INVALID_HASH) + sz += ptr->dbterm.size + 2; + ptr = ptr->next; + } } hp = HAlloc(p, sz); @@ -2730,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((&oldp->dbterm == handle->dbterm) == !(tbl->common.compress && handle->mustResize)); + ASSERT((&b->dbterm == handle->dbterm) == !(tb->common.compress && handle->flags & DB_MUST_RESIZE)); + + 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); @@ -2833,6 +2972,7 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) erts_smp_rwmtx_t* lck; int sum = 0; int sq_sum = 0; + int kept_items = 0; int ix; int len; @@ -2844,6 +2984,8 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) len = 0; for (b = BUCKET(tb,ix); b!=NULL; b=b->next) { len++; + if (b->hvalue == INVALID_HASH) + ++kept_items; } sum += len; sq_sum += len*len; @@ -2855,7 +2997,8 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) stats->std_dev_chain_len = sqrt((sq_sum - stats->avg_chain_len*sum) / NACTIVE(tb)); /* Expected standard deviation from a good uniform hash function, ie binomial distribution (not taking the linear hashing into acount) */ - stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb))); + stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb))); + stats->kept_items = kept_items; } #ifdef HARDDEBUG diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 908cec11d4..f12cd363b0 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. 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 @@ -42,7 +42,7 @@ typedef struct hash_db_term { typedef struct db_table_hash_fine_locks { union { erts_smp_rwmtx_t lck; - byte _cache_line_alignment[64]; + byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))]; }lck_vec[DB_HASH_LOCK_CNT]; } DbTableHashFineLocks; @@ -104,6 +104,7 @@ typedef struct { float std_dev_expected; int max_chain_len; int min_chain_len; + int kept_items; }DbHashStats; void db_calc_stats_hash(DbTableHash* tb, DbHashStats*); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index a62a83a928..c7bccc78c3 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -383,6 +383,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm pattern, Eterm *ret); static int db_select_delete_continue_tree(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); +static int db_take_tree(Process *, DbTable *, Eterm, Eterm *); static void db_print_tree(int to, void *to_arg, int show, DbTable *tbl); static int db_free_table_tree(DbTable *tbl); @@ -398,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 @@ -431,6 +435,7 @@ DbTableMethod db_tree = db_select_delete_continue_tree, db_select_count_tree, db_select_count_continue_tree, + db_take_tree, db_delete_all_objects_tree, db_free_table_tree, db_free_table_continue_tree, @@ -1111,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); } @@ -1319,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); } @@ -1424,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); @@ -1668,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); @@ -1722,6 +1727,28 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, } +static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm *this; + + *ret = NIL; + this = linkout_tree(tb, key, NULL); + if (this) { + Eterm copy, *hp, *hend; + + hp = HAlloc(p, this->dbterm.size + 2); + hend = hp + this->dbterm.size + 2; + copy = db_copy_object_from_ets(&tb->common, + &this->dbterm, &hp, &MSO(p)); + *ret = CONS(hp, copy, NIL); + hp += 2; + HRelease(p, hend, hp); + free_term(tb, this); + } + return DB_ERROR_NONE; +} + /* ** Other interface routines (not directly coupled to one bif) */ @@ -2522,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 @@ -2540,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; @@ -2656,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 3927615e04..c6c3c55a7e 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -198,11 +198,6 @@ set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer, return ret; } - -/* Type checking... */ - -#define BOXED_IS_TUPLE(Boxed) is_arity_value(*boxed_val((Boxed))) - /* ** ** Types and enum's (compiled matches) @@ -218,7 +213,9 @@ typedef enum { matchTuple, matchPushT, matchPushL, + matchPushM, matchPop, + matchSwap, matchBind, matchCmp, matchEqBin, @@ -227,11 +224,15 @@ typedef enum { matchEqRef, matchEq, matchList, + matchMap, + matchKey, matchSkip, matchPushC, matchConsA, /* Car is below Cdr */ matchConsB, /* Cdr is below Car (unusual) */ matchMkTuple, + matchMkFlatMap, + matchMkHashMap, matchCall0, matchCall1, matchCall2, @@ -856,6 +857,13 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info); static Uint my_size_object(Eterm t); static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap); +/* Guard subroutines */ +static void +dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text, + int textpos, Eterm *p, Uint nelems); +static DMCRet +dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm *p, Uint nelems, int *constant); /* Guard compilation */ static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(UWord) *text, Eterm t); @@ -869,6 +877,9 @@ static DMCRet dmc_tuple(DMCContext *context, DMC_STACK_TYPE(UWord) *text, Eterm t, int *constant); +static DMCRet +dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant); static DMCRet dmc_variable(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -888,12 +899,14 @@ static DMCRet compile_guard_expr(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, Eterm t); -/* match expression subroutine */ +/* match expression subroutines */ static DMCRet dmc_one_term(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(Eterm) *stack, DMC_STACK_TYPE(UWord) *text, Eterm c); +static Eterm +dmc_private_copy(DMCContext *context, Eterm c); #ifdef DMC_DEBUG @@ -1364,7 +1377,112 @@ restart: for (;;) { switch (t & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(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 = flatmap_get_keys(flatmap_val(t))[i]; + if (db_is_variable(key) >= 0) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Variable found in map key.", + -1, 0UL, dmcError); + } + 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); + } + goto error; + } + 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); + } + } + 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); + } + 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)) { goto simple_term; } num_iters = arityval(*tuple_val(t)); @@ -1715,10 +1833,8 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Uint32 *return_flags) { MatchProg *prog = Binary2MatchProg(bprog); - Eterm *ep; - Eterm *tp; + const Eterm *ep, *tp, **sp; Eterm t; - Eterm **sp; Eterm *esp; MatchVariable* variables; BeamInstr *cp; @@ -1808,7 +1924,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, restart: ep = &term; esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset); - sp = (Eterm **) esp; + sp = (const Eterm **)esp; ret = am_true; do_catch = 0; fail_label = -1; @@ -1887,9 +2003,57 @@ restart: *sp++ = list_val_rel(*ep,base); ++ep; break; + case matchMap: + if (!is_map_rel(*ep, base)) { + FAIL(); + } + n = *pc++; + 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 (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 matchKey: + t = (Eterm) *pc++; + tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base); + if (!tp) { + FAIL(); + } + *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++; @@ -1987,6 +2151,38 @@ restart: } *esp++ = t; break; + case matchMkFlatMap: + n = *pc++; + ehp = HAllocX(build_proc, MAP_HEADER_FLATMAP_SZ + n, HEAP_XTRA); + t = *--esp; + { + flatmap_t *m = (flatmap_t *)ehp; + m->thing_word = MAP_HEADER_FLATMAP; + m->size = n; + m->keys = t; + } + 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); @@ -2601,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]; } @@ -2637,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; @@ -2701,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) { @@ -3151,39 +3347,86 @@ 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 */ /* return 0 if obj is fully ground */ -int db_has_variable(Eterm obj) -{ - switch(obj & _TAG_PRIMARY_MASK) { - case TAG_PRIMARY_LIST: { - while (is_list(obj)) { - if (db_has_variable(CAR(list_val(obj)))) +int db_has_variable(Eterm node) { + DECLARE_ESTACK(s); + + ESTACK_PUSH(s,node); + while (!ESTACK_ISEMPTY(s)) { + node = ESTACK_POP(s); + switch(node & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + while (is_list(node)) { + ESTACK_PUSH(s,CAR(list_val(node))); + node = CDR(list_val(node)); + } + ESTACK_PUSH(s,node); /* Non wellformed list or [] */ + break; + case TAG_PRIMARY_BOXED: + if (is_tuple(node)) { + Eterm *tuple = tuple_val(node); + int arity = arityval(*tuple); + 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) { + DESTROY_ESTACK(s); return 1; - obj = CDR(list_val(obj)); - } - return(db_has_variable(obj)); /* Non wellformed list or [] */ - } - case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(obj)) { - return 0; - } else { - Eterm *tuple = tuple_val(obj); - int arity = arityval(*tuple++); - while(arity--) { - if (db_has_variable(*tuple)) - return 1; - tuple++; } - return(0); + break; } - case TAG_PRIMARY_IMMED1: - if (obj == am_Underscore || db_is_variable(obj) >= 0) - return 1; } + DESTROY_ESTACK(s); return 0; } @@ -3243,11 +3486,9 @@ static DMCRet dmc_one_term(DMCContext *context, { Sint n; Eterm *hp; - ErlHeapFragment *tmp_mb; Uint sz, sz2, sz3; Uint i, j; - switch (c & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_IMMED1: if ((n = db_is_variable(c)) >= 0) { /* variable */ @@ -3334,6 +3575,16 @@ static DMCRet dmc_one_term(DMCContext *context, DMC_PUSH(*text, n); DMC_PUSH(*stack, c); break; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): + 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); + DMC_PUSH(*stack, c); + break; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): { Eterm* ref_val = internal_ref_val(c); @@ -3415,16 +3666,8 @@ static DMCRet dmc_one_term(DMCContext *context, #endif break; default: /* BINARY, FUN, VECTOR, or EXTERNAL */ - /* - ** Make a private copy... - */ - n = size_object(c); - tmp_mb = new_message_buffer(n); - hp = tmp_mb->mem; DMC_PUSH(*text, matchEqBin); - DMC_PUSH(*text, copy_struct(c, n, &hp, &(tmp_mb->off_heap))); - tmp_mb->next = context->save; - context->save = tmp_mb; + DMC_PUSH(*text, dmc_private_copy(context, c)); break; } break; @@ -3437,6 +3680,22 @@ static DMCRet dmc_one_term(DMCContext *context, } /* +** Make a private copy of a term in a context. +*/ + +static Eterm +dmc_private_copy(DMCContext *context, Eterm c) +{ + Uint n = size_object(c); + ErlHeapFragment *tmp_mb = new_message_buffer(n); + Eterm *hp = tmp_mb->mem; + Eterm copy = copy_struct(c, n, &hp, &(tmp_mb->off_heap)); + tmp_mb->next = context->save; + context->save = tmp_mb; + return copy; +} + +/* ** Match guard compilation */ @@ -3527,57 +3786,78 @@ static DMCRet dmc_list(DMCContext *context, return retOk; } -static DMCRet dmc_tuple(DMCContext *context, - DMCHeap *heap, - DMC_STACK_TYPE(UWord) *text, - Eterm t, - int *constant) +static void +dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text, + int textpos, Eterm *p, Uint nelems) { DMC_STACK_TYPE(UWord) instr_save; + Uint i; + + DMC_INIT_STACK(instr_save); + while (DMC_STACK_NUM(*text) > textpos) { + DMC_PUSH(instr_save, DMC_POP(*text)); + } + for (i = nelems; i--;) { + do_emit_constant(context, text, p[i]); + } + while(!DMC_EMPTY(instr_save)) { + DMC_PUSH(*text, DMC_POP(instr_save)); + } + DMC_FREE(instr_save); +} + +static DMCRet +dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm *p, Uint nelems, int *constant) +{ int all_constant = 1; int textpos = DMC_STACK_NUM(*text); - Eterm *p = tuple_val(t); - Uint nelems = arityval(*p); Uint i; - int c; - DMCRet ret; /* - ** We remember where we started to layout code, + ** We remember where we started to layout code, ** assume all is constant and back up and restart if not so. - ** The tuple should be laid out with the last element first, - ** so we can memcpy the tuple to the eheap. + ** The array should be laid out with the last element first, + ** so we can memcpy it to the eheap. */ - for (i = nelems; i > 0; --i) { - if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) - return ret; - if (!c && all_constant) { - all_constant = 0; - if (i < nelems) { - Uint j; + for (i = nelems; i--;) { + DMCRet ret; + int c; - /* - * Oops, we need to relayout the constants. - * Save the already laid out instructions. - */ - DMC_INIT_STACK(instr_save); - while (DMC_STACK_NUM(*text) > textpos) - DMC_PUSH(instr_save, DMC_POP(*text)); - for (j = nelems; j > i; --j) - do_emit_constant(context, text, p[j]); - while(!DMC_EMPTY(instr_save)) - DMC_PUSH(*text, DMC_POP(instr_save)); - DMC_FREE(instr_save); - } - } else if (c && !all_constant) { - /* push a constant */ - do_emit_constant(context, text, p[i]); - } + ret = dmc_expr(context, heap, text, p[i], &c); + if (ret != retOk) { + return ret; + } + if (!c && all_constant) { + all_constant = 0; + if (i < nelems - 1) { + dmc_rearrange_constants(context, text, textpos, + p + i + 1, nelems - i - 1); + } + } else if (c && !all_constant) { + do_emit_constant(context, text, p[i]); + } + } + *constant = all_constant; + return retOk; +} + +static DMCRet +dmc_tuple(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant) +{ + int all_constant; + Eterm *p = tuple_val(t); + Uint nelems = arityval(*p); + DMCRet ret; + + ret = dmc_array(context, heap, text, p + 1, nelems, &all_constant); + if (ret != retOk) { + return ret; } - if (all_constant) { - *constant = 1; - return retOk; + *constant = 1; + return retOk; } DMC_PUSH(*text, matchMkTuple); DMC_PUSH(*text, nelems); @@ -3586,6 +3866,93 @@ static DMCRet dmc_tuple(DMCContext *context, return retOk; } +static DMCRet +dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant) +{ + 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); + + 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; + } +} + static DMCRet dmc_whole_expression(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -4580,7 +4947,10 @@ static DMCRet dmc_expr(DMCContext *context, return ret; break; case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(t)) { + if (is_map(t)) { + return dmc_map(context, heap, text, t, constant); + } + if (!is_tuple(t)) { goto simple_term; } p = tuple_val(t); @@ -4855,7 +5225,7 @@ static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap) *hp += 2; break; case TAG_PRIMARY_BOXED: - if (BOXED_IS_TUPLE(t)) { + if (is_tuple(t)) { if (arityval(*tuple_val(t)) == 1 && is_tuple(a = tuple_val(t)[1])) { Uint i,n; @@ -5126,6 +5496,18 @@ void db_match_dis(Binary *bp) ++t; erts_printf("Tuple\t%beu\n", n); break; + case matchMap: + ++t; + n = *t; + ++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; @@ -5136,10 +5518,20 @@ void db_match_dis(Binary *bp) ++t; erts_printf("PushL\n"); break; + case matchPushM: + ++t; + n = *t; + ++t; + erts_printf("PushM\t%beu\n", n); + break; case matchPop: ++t; erts_printf("Pop\n"); break; + case matchSwap: + ++t; + erts_printf("Swap\n"); + break; case matchBind: ++t; n = *t; @@ -5252,6 +5644,18 @@ void db_match_dis(Binary *bp) ++t; erts_printf("MkTuple\t%beu\n", n); break; + case matchMkFlatMap: + ++t; + n = *t; + ++t; + erts_printf("MkFlatMap\t%beu\n", n); + break; + case matchMkHashMap: + ++t; + n = *t; + ++t; + erts_printf("MkHashMap\t%beu\n", n); + break; case matchOr: ++t; n = *t; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 328b19dfc9..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 */ @@ -165,6 +168,7 @@ typedef struct db_table_method DbTable* tb, /* [in out] */ Eterm continuation, Eterm* ret); + int (*db_take)(Process *, DbTable *, Eterm, Eterm *); int (*db_delete_all_objects)(Process* p, DbTable* db /* [in out] */ ); @@ -182,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; @@ -339,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 147249f751..240faa823d 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -601,17 +601,16 @@ erl_drv_thread_create(char *name, #ifdef USE_THREADS int res; struct ErlDrvTid_ *dtid; - ethr_thr_opts ethr_opts; + ethr_thr_opts ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; ethr_thr_opts *use_opts; - ethr_thr_opts def_ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; - if (!opts) + if (!opts && !name) use_opts = NULL; else { - sys_memcpy((void *) ðr_opts, - (void *) &def_ethr_opts, - sizeof(ethr_thr_opts)); - 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 3856fc0a6a..5a3fa33da8 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -20,6 +20,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -37,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 @@ -173,15 +176,15 @@ erts_init_gc(void) int i = 0, ix; Sint max_heap_size = 0; - ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word)); - ASSERT(offsetof(ProcBin,thing_word) == offsetof(ErlFunThing,thing_word)); - ASSERT(offsetof(ProcBin,thing_word) == offsetof(ExternalThing,header)); - ASSERT(offsetof(ProcBin,size) == offsetof(struct erl_off_heap_header,size)); - ASSERT(offsetof(ProcBin,size) == offsetof(ErlSubBin,size)); - ASSERT(offsetof(ProcBin,size) == offsetof(ErlHeapBin,size)); - ASSERT(offsetof(ProcBin,next) == offsetof(struct erl_off_heap_header,next)); - ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next)); - ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next)); + ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word)); + ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(ErlFunThing,thing_word)); + ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(ExternalThing,header)); + ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(struct erl_off_heap_header,size)); + ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(ErlSubBin,size)); + ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(ErlHeapBin,size)); + ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(struct erl_off_heap_header,next)); + ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next)); + ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next)); erts_test_long_gc_sleep = 0; @@ -400,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); @@ -417,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); @@ -468,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) { @@ -1226,7 +1226,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)); @@ -1436,13 +1435,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); + } } } @@ -1505,13 +1507,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; } @@ -2419,7 +2420,6 @@ sweep_off_heap(Process *p, int fullsweep) } pb->val = erts_bin_realloc(pb->val, new_size); - pb->val->orig_size = new_size; pb->bytes = (byte *) pb->val->orig_bytes; } } @@ -2665,11 +2665,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; @@ -2677,7 +2673,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); @@ -2701,7 +2697,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 5203dda263..bd6dcc9078 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -20,10 +20,12 @@ #ifndef __ERL_GC_H__ #define __ERL_GC_H__ -#include "erl_map.h" +#if defined(ERL_WANT_GC_INTERNALS__) || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ +#include "erl_map.h" + #if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF # define HARDDEBUG 1 #endif @@ -53,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); \ @@ -61,14 +66,11 @@ do { \ *HTOP++ = HDR; \ *PTR++ = gval; \ while (nelts--) *HTOP++ = *PTR++; \ - \ } while(0) #define in_area(ptr,start,nbytes) \ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) -extern Uint erts_test_long_gc_sleep; - #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) int within(Eterm *ptr, Process *p); #endif @@ -97,4 +99,33 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term) } #endif +#endif /* ERL_GC_C__ || HIPE_GC_C__ */ + +/* + * Global exported + */ + +extern Uint erts_test_long_gc_sleep; + +typedef struct { + Uint64 reclaimed; + Uint64 garbage_cols; +} ErtsGCInfo; + +void erts_gc_info(ErtsGCInfo *gcip); +void erts_init_gc(void); +int erts_garbage_collect(struct process*, int, Eterm*, int); +void erts_garbage_collect_hibernate(struct process* p); +Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); +void erts_garbage_collect_literals(struct process* p, Eterm* literals, + Uint lit_size, + struct erl_off_heap_header* oh); +Uint erts_next_heap_size(Uint, Uint); +Eterm erts_heap_sizes(struct process* p); + +void erts_offset_off_heap(struct erl_off_heap*, Sint, Eterm*, Eterm*); +void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_free_heap_frags(struct process* p); + #endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c new file mode 100644 index 0000000000..51cd843935 --- /dev/null +++ b/erts/emulator/beam/erl_hl_timer.c @@ -0,0 +1,2894 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: High level timers implementing BIF timers + * as well as process and port timers. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "bif.h" +#include "erl_bif_unique.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" +#include "erl_hl_timer.h" + +#define ERTS_TMR_CHECK_CANCEL_ON_CREATE 0 + +#if 0 +# define ERTS_HLT_HARD_DEBUG +#endif +#if 0 +# define ERTS_HLT_DEBUG +#endif + +#if defined(ERTS_HLT_HARD_DEBUG) || defined(DEBUG) +# if defined(ERTS_HLT_HARD_DEBUG) +# undef ERTS_RBT_HARD_DEBUG +# define ERTS_RBT_HARD_DEBUG 1 +# endif +# ifndef ERTS_HLT_DEBUG +# define ERTS_HLT_DEBUG 1 +# endif +#endif + +#undef ERTS_HLT_ASSERT +#if defined(ERTS_HLT_DEBUG) +# define ERTS_HLT_ASSERT(E) ERTS_ASSERT(E) +# undef ERTS_RBT_DEBUG +# define ERTS_RBT_DEBUG +#else +# define ERTS_HLT_ASSERT(E) ((void) 1) +#endif + +#if defined(ERTS_HLT_HARD_DEBUG) && defined(__GNUC__) +#warning "* * * * * * * * * * * * * * * * * *" +#warning "* ERTS_HLT_HARD_DEBUG IS ENABLED! *" +#warning "* * * * * * * * * * * * * * * * * *" +#endif + +#ifdef ERTS_HLT_HARD_DEBUG +# define ERTS_HLT_HDBG_CHK_SRV(SRV) hdbg_chk_srv((SRV)) +static void hdbg_chk_srv(ErtsHLTimerService *srv); +#else +# define ERTS_HLT_HDBG_CHK_SRV(SRV) ((void) 1) +#endif + +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + +#define ERTS_BIF_TIMER_SHORT_TIME 5000 + +#ifdef ERTS_SMP +# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore \ + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore) +#else +# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore +#endif + +/* Bit 0 to 9 contains scheduler id (see mask below) */ +#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 10) +#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 11) +#define ERTS_TMR_ROFLG_ABIF_TMR (((Uint32) 1) << 12) +#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 13) +#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 14) +#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 15) +#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 16) + +#define ERTS_TMR_ROFLG_SID_MASK \ + (ERTS_TMR_ROFLG_HLT - (Uint32) 1) + +#define ERTS_TMR_STATE_ACTIVE ((erts_aint32_t) 0) +#define ERTS_TMR_STATE_CANCELED ((erts_aint32_t) 1) +#define ERTS_TMR_STATE_TIMED_OUT ((erts_aint32_t) 2) + +typedef struct ErtsHLTimer_ ErtsHLTimer; + +#define ERTS_HLT_PFLG_RED (((UWord) 1) << 0) +#define ERTS_HLT_PFLG_SAME_TIME (((UWord) 1) << 1) + +#define ERTS_HLT_PFLGS_MASK \ + (ERTS_HLT_PFLG_RED|ERTS_HLT_PFLG_SAME_TIME) + +#define ERTS_HLT_PFIELD_NOT_IN_TABLE (~((UWord) 0)) + +typedef struct { + UWord parent; /* parent pointer and flags... */ + union { + struct { + ErtsHLTimer *right; + ErtsHLTimer *left; + } t; + struct { + ErtsHLTimer *prev; + ErtsHLTimer *next; + } l; + } u; + ErtsHLTimer *same_time; +} ErtsHLTimerTimeTree; + +typedef struct { + UWord parent; /* parent pointer and flags... */ + ErtsHLTimer *right; + ErtsHLTimer *left; +} ErtsHLTimerTree; + +typedef struct { + Uint32 roflgs; + erts_smp_atomic32_t refc; + union { + erts_atomic_t next; + } u; +} ErtsTmrHead; + +struct ErtsHLTimer_ { + ErtsTmrHead head; /* NEED to be first! */ + union { + ErtsThrPrgrLaterOp cleanup; + ErtsHLTimerTimeTree tree; + } time; + ErtsMonotonicTime timeout; + union { + Process *proc; + Port *port; + Eterm name; + } receiver; + +#ifdef ERTS_HLT_HARD_DEBUG + int pending_timeout; +#endif + + erts_smp_atomic32_t state; + + /* BIF timer only fields follow... */ + struct { + Uint32 refn[ERTS_REF_NUMBERS]; + ErtsHLTimerTree proc_tree; + ErtsHLTimerTree tree; + Eterm message; + ErlHeapFragment *bp; + } btm; + struct { + Eterm accessor; + ErtsHLTimerTree tree; + } abtm; +}; + +#define ERTS_HL_PTIMER_SIZE offsetof(ErtsHLTimer, btm) +#define ERTS_BIF_TIMER_SIZE offsetof(ErtsHLTimer, abtm) +#define ERTS_ABIF_TIMER_SIZE sizeof(ErtsHLTimer) + +typedef struct { + ErtsTmrHead head; /* NEED to be first! */ + void *p; + ErtsTWheelTimer tw_tmr; +} ErtsTWTimer; + +typedef union { + ErtsTmrHead head; + ErtsHLTimer hlt; + ErtsTWTimer twt; +} ErtsTimer; + +#ifdef SMALL_MEMORY +#define BIF_TIMER_PREALC_SZ 10 +#define PTIMER_PREALC_SZ 10 +#else +#define BIF_TIMER_PREALC_SZ 100 +#define PTIMER_PREALC_SZ 100 +#endif + +ERTS_SCHED_PREF_PALLOC_IMPL(bif_timer_pre, + ErtsHLTimer, + BIF_TIMER_PREALC_SZ) + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(tw_timer, + ErtsTWTimer, + PTIMER_PREALC_SZ, + ERTS_ALC_T_LL_PTIMER) + +#ifdef ERTS_HLT_DEBUG +#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 5 +#else +#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 100 +#endif +#define ERTS_TMR_CANCELED_TIMER_LIMIT 100 +#define ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT 5 + +#define ERTS_TMR_TIMEOUT_YIELD_STATE_T same_time_list_yield_state_t +#define ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER {NULL, {0}} +typedef struct { + int dummy; +} ERTS_TMR_TIMEOUT_YIELD_STATE_T; + +typedef struct { + ErtsTmrHead marker; + erts_atomic_t last; +} ErtsHLTCncldTmrQTail; + +#ifdef ERTS_SMP + +typedef struct { + /* + * This structure needs to be cache line aligned for best + * performance. + */ + union { + /* + * Modified by threads returning canceled + * timers to this timer service. + */ + ErtsHLTCncldTmrQTail data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE( + sizeof(ErtsHLTCncldTmrQTail))]; + } tail; + /* + * Everything below this point is *only* accessed by the + * thread managing this timer service. + */ + struct { + ErtsTimer *first; + ErtsTimer *unref_end; + struct { + ErtsThrPrgrVal thr_progress; + int thr_progress_reached; + ErtsTimer *unref_end; + } next; + int used_marker; + } head; +} ErtsHLTCncldTmrQ; + +#endif /* ERTS_SMP */ + +typedef struct { + ErtsHLTimer *root; + ERTS_TMR_TIMEOUT_YIELD_STATE_T state; +} ErtsYieldingTimeoutState; + +struct ErtsHLTimerService_ { +#ifdef ERTS_SMP + ErtsHLTCncldTmrQ canceled_queue; +#endif + ErtsHLTimer *time_tree; + ErtsHLTimer *btm_tree; + ErtsHLTimer *next_timeout; + ErtsYieldingTimeoutState yield; + ErtsTWheelTimer service_timer; +}; + +static ERTS_INLINE int +refn_is_lt(Uint32 *x, Uint32 *y) +{ + /* !0 if x < y */ + if (x[2] < y[2]) + return 1; + if (x[2] != y[2]) + return 0; + if (x[1] < y[1]) + return 1; + if (x[1] != y[1]) + return 0; + return x[0] < y[0]; +} + +#define ERTS_RBT_PREFIX time +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T ErtsMonotonicTime +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->time.tree.parent = (UWord) NULL; \ + (T)->time.tree.u.t.right = NULL; \ + (T)->time.tree.u.t.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->time.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->time.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->time.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->time.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->time.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->time.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->time.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->time.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->time.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->time.tree.u.t.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->time.tree.u.t.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->time.tree.u.t.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->time.tree.u.t.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->timeout) +#define ERTS_RBT_IS_LT(KX, KY) ((KX) < (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) ((KX) == (KY)) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_SMALLEST +#define ERTS_RBT_WANT_LOOKUP_INSERT +#define ERTS_RBT_WANT_REPLACE +#ifdef ERTS_HLT_HARD_DEBUG +# define ERTS_RBT_WANT_FOREACH +# define ERTS_RBT_WANT_LOOKUP +#endif +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +/* Use circular list for timers at same time */ + +static ERTS_INLINE void +same_time_list_insert(ErtsHLTimer **root, ErtsHLTimer *tmr) +{ + ErtsHLTimer *first = *root; + if (!first) { + ERTS_HLT_ASSERT((((UWord) root) & ERTS_HLT_PFLG_SAME_TIME) == 0); + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + tmr->time.tree.u.l.next = tmr; + tmr->time.tree.u.l.prev = tmr; + *root = tmr; + } + else { + tmr->time.tree.parent = ERTS_HLT_PFLG_SAME_TIME; + tmr->time.tree.u.l.next = first; + tmr->time.tree.u.l.prev = first->time.tree.u.l.prev; + first->time.tree.u.l.prev = tmr; + tmr->time.tree.u.l.prev->time.tree.u.l.next = tmr; + } +} + +static ERTS_INLINE void +same_time_list_delete(ErtsHLTimer *tmr) +{ + ErtsHLTimer **root, *next; + + root = (ErtsHLTimer **) (tmr->time.tree.parent & ~ERTS_HLT_PFLG_SAME_TIME); + next = tmr->time.tree.u.l.next; + + ERTS_HLT_ASSERT((tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)) + || (tmr->time.tree.parent + == ERTS_HLT_PFLG_SAME_TIME)); + + if (next == tmr) { + ERTS_HLT_ASSERT(root && *root == tmr); + ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev == tmr); + *root = NULL; + } + else { + if (root) { + ERTS_HLT_ASSERT(*root == tmr); + *root = next; + next->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + } + tmr->time.tree.u.l.next->time.tree.u.l.prev = tmr->time.tree.u.l.prev; + tmr->time.tree.u.l.prev->time.tree.u.l.next = next; + } +} + +static ERTS_INLINE void +same_time_list_new_root(ErtsHLTimer **root) +{ + ErtsHLTimer *tmr = *root; + if (tmr) { + ERTS_HLT_ASSERT(root); + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + } +} + +static ERTS_INLINE int +same_time_list_foreach_destroy_yielding(ErtsHLTimer **root, + void (*op)(ErtsHLTimer *, void *), + void *arg, + ERTS_TMR_TIMEOUT_YIELD_STATE_T *ys, + Sint ylimit) +{ + Sint ycnt = ylimit; + ErtsHLTimer *end, *tmr = *root; + if (!tmr) + return 0; + + ERTS_HLT_ASSERT(tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)); + + end = tmr->time.tree.u.l.prev; + end->time.tree.u.l.next = NULL; + + while (1) { + ErtsHLTimer *op_tmr = tmr; + + ERTS_HLT_ASSERT((tmr->time.tree.parent + == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME)) + || (tmr->time.tree.parent + == ERTS_HLT_PFLG_SAME_TIME)); + + tmr = tmr->time.tree.u.l.next; + (*op)(op_tmr, arg); + if (!tmr) { + *root = NULL; + return 0; + } + if (--ycnt <= 0) { + /* Make new circle of timers left to process... */ + *root = tmr; + end->time.tree.u.l.next = tmr; + tmr->time.tree.u.l.prev = end; + tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME; + return 1; + } + } +} + +#ifdef ERTS_HLT_HARD_DEBUG + +static ERTS_INLINE void +same_time_list_foreach(ErtsHLTimer *root, + void (*op)(ErtsHLTimer *, void *), + void *arg) +{ + if (root) { + ErtsHLTimer *tmr = root; + do { + (*op)(tmr, arg); + tmr = tmr->time.tree.u.l.next; + } while (root != tmr); + } +} + +static ERTS_INLINE ErtsHLTimer * +same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) +{ + if (root) { + ErtsHLTimer *tmr = root; + do { + if (tmr == x) + return tmr; + tmr = tmr->time.tree.u.l.next; + } while (root != tmr); + } + return NULL; +} + +#endif /* ERTS_HLT_HARD_DEBUG */ + +#define ERTS_RBT_PREFIX btm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->btm.tree.parent = (UWord) NULL; \ + (T)->btm.tree.right = NULL; \ + (T)->btm.tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->btm.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->btm.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->btm.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->btm.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->btm.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->btm.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->btm.tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#define ERTS_RBT_PREFIX proc_btm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->btm.proc_tree.parent = (UWord) NULL; \ + (T)->btm.proc_tree.right = NULL; \ + (T)->btm.proc_tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->btm.proc_tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->btm.proc_tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->btm.proc_tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->btm.proc_tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->btm.proc_tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->btm.proc_tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->btm.proc_tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.proc_tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.proc_tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->btm.proc_tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.proc_tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#define ERTS_RBT_PREFIX abtm +#define ERTS_RBT_T ErtsHLTimer +#define ERTS_RBT_KEY_T Uint32 * +#define ERTS_RBT_FLAGS_T UWord +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->abtm.tree.parent = (UWord) NULL; \ + (T)->abtm.tree.right = NULL; \ + (T)->abtm.tree.left = NULL; \ + } while (0) +#define ERTS_RBT_IS_RED(T) \ + ((int) ((T)->abtm.tree.parent & ERTS_HLT_PFLG_RED)) +#define ERTS_RBT_SET_RED(T) \ + ((T)->abtm.tree.parent |= ERTS_HLT_PFLG_RED) +#define ERTS_RBT_IS_BLACK(T) \ + (!ERTS_RBT_IS_RED((T))) +#define ERTS_RBT_SET_BLACK(T) \ + ((T)->abtm.tree.parent &= ~ERTS_HLT_PFLG_RED) +#define ERTS_RBT_GET_FLAGS(T) \ + ((T)->abtm.tree.parent & ERTS_HLT_PFLGS_MASK) +#define ERTS_RBT_SET_FLAGS(T, F) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->abtm.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \ + (T)->abtm.tree.parent |= (F); \ + } while (0) +#define ERTS_RBT_GET_PARENT(T) \ + ((ErtsHLTimer *) ((T)->abtm.tree.parent & ~ERTS_HLT_PFLGS_MASK)) +#define ERTS_RBT_SET_PARENT(T, P) \ + do { \ + ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \ + (T)->abtm.tree.parent &= ERTS_HLT_PFLGS_MASK; \ + (T)->abtm.tree.parent |= (UWord) (P); \ + } while (0) +#define ERTS_RBT_GET_RIGHT(T) ((T)->abtm.tree.right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->abtm.tree.right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->abtm.tree.left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->abtm.tree.left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->btm.refn) +#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY)) +#define ERTS_RBT_IS_EQ(KX, KY) \ + (((KX)[0] == (KY)[0]) & ((KX)[1] == (KY)[1]) & ((KX)[2] == (KY)[2])) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +#ifdef ERTS_SMP +static void init_canceled_queue(ErtsHLTCncldTmrQ *cq); +#endif + +void +erts_hl_timer_init(void) +{ + init_tw_timer_alloc(); + init_bif_timer_pre_alloc(); +} + +ErtsHLTimerService * +erts_create_timer_service(void) +{ + ErtsYieldingTimeoutState init_yield = ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER; + ErtsHLTimerService *srv; + + srv = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_SERVICE, + sizeof(ErtsHLTimerService)); + srv->time_tree = NULL; + srv->btm_tree = NULL; + srv->next_timeout = NULL; + srv->yield = init_yield; + erts_twheel_init_timer(&srv->service_timer); + +#ifdef ERTS_SMP + init_canceled_queue(&srv->canceled_queue); +#endif + + return srv; +} + +size_t +erts_timer_type_size(ErtsAlcType_t type) +{ + switch (type) { + case ERTS_ALC_T_LL_PTIMER: return sizeof(ErtsTWTimer); + case ERTS_ALC_T_HL_PTIMER: return ERTS_HL_PTIMER_SIZE; + case ERTS_ALC_T_BIF_TIMER: return ERTS_BIF_TIMER_SIZE; + case ERTS_ALC_T_ABIF_TIMER: return ERTS_ABIF_TIMER_SIZE; + default: ERTS_INTERNAL_ERROR("Unknown type"); + } + return 0; +} + +static ERTS_INLINE ErtsMonotonicTime +get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime msec) +{ + ErtsMonotonicTime timeout_pos; + if (msec <= 0) + return ERTS_MONOTONIC_TO_CLKTCKS(now); + timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(now-1); + timeout_pos += ERTS_MSEC_TO_CLKTCKS(msec) + 1; + return timeout_pos; +} + +static ERTS_INLINE Sint64 +get_time_left(ErtsSchedulerData *esdp, ErtsMonotonicTime timeout_pos) +{ + ErtsMonotonicTime now = erts_get_monotonic_time(esdp); + + now = ERTS_MONOTONIC_TO_CLKTCKS(now-1)+1; + if (timeout_pos <= now) + return (Sint64) 0; + return (Sint64) ERTS_CLKTCKS_TO_MSEC(timeout_pos - now); +} + +static ERTS_INLINE int +proc_timeout_common(Process *proc, void *tmr) +{ + if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&proc->common.timer, + ERTS_PTMR_TIMEDOUT, + (erts_aint_t) tmr)) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&proc->state); + if (!(state & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_EXITING))) + erts_schedule_process(proc, state, 0); + return 1; + } + return 0; +} + +static ERTS_INLINE int +port_timeout_common(Port *port, void *tmr) +{ + if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&port->common.timer, + ERTS_PTMR_TIMEDOUT, + (erts_aint_t) tmr)) { + erts_port_task_schedule(port->common.id, + &port->timeout_task, + ERTS_PORT_TASK_TIMEOUT); + return 1; + } + return 0; +} + +/* + * Basic timer wheel timer stuff + */ + +static void +scheduled_tw_timer_destroy(void *vtmr) +{ + tw_timer_free((ErtsTWTimer *) vtmr); +} + +static void +schedule_tw_timer_destroy(ErtsTWTimer *tmr) +{ + /* + * Reference to process/port can be + * dropped at once... + */ + if (tmr->head.roflgs & ERTS_TMR_ROFLG_PROC) + erts_proc_dec_refc((Process *) tmr->p); + else + erts_port_dec_refc((Port *) tmr->p); + + erts_schedule_thr_prgr_later_cleanup_op( + scheduled_tw_timer_destroy, + (void *) tmr, + &tmr->tw_tmr.u.cleanup, + sizeof(ErtsTWTimer)); +} + +static ERTS_INLINE void +tw_timer_dec_refc(ErtsTWTimer *tmr) +{ + if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) { + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + schedule_tw_timer_destroy(tmr); + } +} + +static void +tw_proc_timeout(void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + Process *proc = (Process *) twtp->p; + if (proc_timeout_common(proc, vtwtp)) + tw_timer_dec_refc(twtp); + tw_timer_dec_refc(twtp); +} + +static void +tw_port_timeout(void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + Port *port = (Port *) twtp->p; + if (port_timeout_common(port, vtwtp)) + tw_timer_dec_refc(twtp); + tw_timer_dec_refc(twtp); +} + +static void +tw_ptimer_cancel(void *vtwtp) +{ + tw_timer_dec_refc((ErtsTWTimer *) vtwtp); +} + +static void +cancel_tw_timer(ErtsSchedulerData *esdp, ErtsTWTimer *tmr) +{ + ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK) + == (Uint32) esdp->no); + erts_twheel_cancel_timer(esdp->timer_wheel, &tmr->tw_tmr); +} + +static ErtsTWTimer * +create_tw_timer(ErtsSchedulerData *esdp, + void *p, int is_proc, + ErtsMonotonicTime timeout_pos) +{ + ErtsTWTimer *tmr; + void (*timeout_func)(void *); + + tmr = tw_timer_alloc(); + erts_twheel_init_timer(&tmr->tw_tmr); + + tmr->head.roflgs = (Uint32) esdp->no; + ERTS_HLT_ASSERT((tmr->head.roflgs + & ~ERTS_TMR_ROFLG_SID_MASK) == 0); + tmr->p = p; + if (is_proc) { + tmr->head.roflgs |= ERTS_TMR_ROFLG_PROC; + timeout_func = tw_proc_timeout; + erts_proc_inc_refc((Process *) p); + } + else { + tmr->head.roflgs |= ERTS_TMR_ROFLG_PORT; + timeout_func = tw_port_timeout; + erts_port_inc_refc((Port *) p); + } + + erts_smp_atomic32_init_nob(&tmr->head.refc, 2); + + erts_twheel_set_timer(esdp->timer_wheel, + &tmr->tw_tmr, + timeout_func, + tw_ptimer_cancel, + tmr, + timeout_pos); + + return tmr; +} + +/* + * Basic high level timer stuff + */ + +static ERTS_INLINE void +hl_timer_destroy(ErtsHLTimer *tmr) +{ + Uint32 roflgs = tmr->head.roflgs; + if (!(roflgs & ERTS_TMR_ROFLG_BIF_TMR)) + erts_free(ERTS_ALC_T_HL_PTIMER, tmr); + else { + if (roflgs & ERTS_TMR_ROFLG_PRE_ALC) + bif_timer_pre_free(tmr); + else if (roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + erts_free(ERTS_ALC_T_ABIF_TIMER, tmr); + else + erts_free(ERTS_ALC_T_BIF_TIMER, tmr); + } +} + +static void +scheduled_hl_timer_destroy(void *vtmr) +{ + hl_timer_destroy((ErtsHLTimer *) vtmr); +} + +static void +schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs) +{ + UWord size; + + /* + * Reference to process/port can be dropped + * at once... + */ + + ERTS_HLT_ASSERT(erts_smp_atomic32_read_nob(&tmr->head.refc) == 0); + + if (roflgs & ERTS_TMR_ROFLG_REG_NAME) { + ERTS_HLT_ASSERT(is_atom(tmr->receiver.name)); + } + else if (roflgs & ERTS_TMR_ROFLG_PROC) { + ERTS_HLT_ASSERT(tmr->receiver.proc); + erts_proc_dec_refc(tmr->receiver.proc); + } + else if (roflgs & ERTS_TMR_ROFLG_PORT) { + ERTS_HLT_ASSERT(tmr->receiver.port); + erts_port_dec_refc(tmr->receiver.port); + } + + if (!(roflgs & ERTS_TMR_ROFLG_BIF_TMR)) + size = ERTS_HL_PTIMER_SIZE; + else { + /* + * Message buffer can be dropped at + * once... + */ + size = sizeof(ErtsHLTimer); + } + + erts_schedule_thr_prgr_later_cleanup_op( + scheduled_hl_timer_destroy, tmr, + &tmr->time.cleanup, size); +} + +static ERTS_INLINE void +hl_timer_pre_dec_refc(ErtsHLTimer *tmr) +{ +#ifdef ERTS_HLT_DEBUG + erts_aint_t refc; + refc = erts_smp_atomic32_dec_read_nob(&tmr->head.refc); + ERTS_HLT_ASSERT(refc > 0); +#else + erts_smp_atomic32_dec_nob(&tmr->head.refc); +#endif +} + +static ERTS_INLINE void +hl_timer_dec_refc(ErtsHLTimer *tmr, Uint32 roflgs) +{ + if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) { + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + schedule_hl_timer_destroy(tmr, roflgs); + } +} + +static void hlt_service_timeout(void *vesdp); +#ifdef ERTS_SMP +static void handle_canceled_queue(ErtsSchedulerData *esdp, + ErtsHLTCncldTmrQ *cq, + int use_limit, + int ops_limit, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work); +#endif + +static ERTS_INLINE void +check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv) +{ +#if defined(ERTS_SMP) && ERTS_TMR_CHECK_CANCEL_ON_CREATE + ErtsHLTCncldTmrQ *cq = &srv->canceled_queue; + if (cq->head.first != cq->head.unref_end) + handle_canceled_queue(esdp, cq, 1, + ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT, + NULL, NULL, NULL); +#endif +} + +static void +hlt_delete_abtm(ErtsHLTimer *tmr) +{ + Process *proc; + + ERTS_HLT_ASSERT(tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR); + + proc = erts_proc_lookup(tmr->abtm.accessor); + + if (proc) { + int deref = 0; + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM); + if (tmr->abtm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + abtm_rbt_delete(&proc->accessor_bif_timers, tmr); + deref = 1; + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + if (deref) + hl_timer_pre_dec_refc(tmr); + } +} + +static ErtsHLTimer * +create_hl_timer(ErtsSchedulerData *esdp, + ErtsMonotonicTime timeout_pos, + int short_time, int is_bif_tmr, + void *rcvrp, Eterm rcvr, Eterm acsr, + Eterm msg, Uint32 *refn) +{ + ErtsHLTimerService *srv = esdp->timer_service; + ErtsHLTimer *tmr, *st_tmr; + erts_aint32_t refc; + Uint32 roflgs; + int is_abif_tmr = is_bif_tmr && is_value(acsr) && acsr != rcvr; + + check_canceled_queue(esdp, srv); + + ERTS_HLT_ASSERT((esdp->no & ~ERTS_TMR_ROFLG_SID_MASK) == 0); + + roflgs = ((Uint32) esdp->no) | ERTS_TMR_ROFLG_HLT; + + if (!is_bif_tmr) + tmr = erts_alloc(ERTS_ALC_T_HL_PTIMER, + ERTS_HL_PTIMER_SIZE); + else if (short_time) { + tmr = bif_timer_pre_alloc(); + if (!tmr) + goto alloc_bif_timer; + roflgs |= ERTS_TMR_ROFLG_PRE_ALC; + } + else { + alloc_bif_timer: + if (is_abif_tmr) + tmr = erts_alloc(ERTS_ALC_T_ABIF_TIMER, + ERTS_ABIF_TIMER_SIZE); + else + tmr = erts_alloc(ERTS_ALC_T_BIF_TIMER, + ERTS_BIF_TIMER_SIZE); + } + + tmr->timeout = timeout_pos; + + if (!is_bif_tmr) { + if (is_internal_pid(rcvr)) { + erts_proc_inc_refc((Process *) rcvrp); + tmr->receiver.proc = (Process *) rcvrp; + roflgs |= ERTS_TMR_ROFLG_PROC; + } + else { + erts_port_inc_refc((Port *) rcvrp); + ERTS_HLT_ASSERT(is_internal_port(rcvr)); + tmr->receiver.port = (Port *) rcvrp; + roflgs |= ERTS_TMR_ROFLG_PORT; + } + refc = 2; + } + else { + Uint hsz; + + roflgs |= ERTS_TMR_ROFLG_BIF_TMR; + if (is_internal_pid(rcvr)) { + roflgs |= ERTS_TMR_ROFLG_PROC; + tmr->receiver.proc = (Process *) rcvrp; + refc = 2; + } + else { + ERTS_HLT_ASSERT(is_atom(rcvr)); + roflgs |= ERTS_TMR_ROFLG_REG_NAME; + tmr->receiver.name = rcvr; + refc = 1; + } + + hsz = is_immed(msg) ? ((Uint) 0) : size_object(msg); + if (!hsz) { + tmr->btm.message = msg; + tmr->btm.bp = NULL; + } + else { + ErlHeapFragment *bp = new_message_buffer(hsz); + Eterm *hp = bp->mem; + tmr->btm.message = copy_struct(msg, hsz, &hp, &bp->off_heap); + tmr->btm.bp = bp; + } + tmr->btm.refn[0] = refn[0]; + tmr->btm.refn[1] = refn[1]; + tmr->btm.refn[2] = refn[2]; + + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + if (is_abif_tmr) { + Process *aproc; + roflgs |= ERTS_TMR_ROFLG_ABIF_TMR; + tmr->abtm.accessor = acsr; + aproc = erts_proc_lookup(acsr); + if (!aproc) + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + else { + refc++; + erts_smp_proc_lock(aproc, ERTS_PROC_LOCK_BTM); + abtm_rbt_insert(&aproc->accessor_bif_timers, tmr); + erts_smp_proc_unlock(aproc, ERTS_PROC_LOCK_BTM); + } + } + } + + tmr->head.roflgs = roflgs; + erts_smp_atomic32_init_nob(&tmr->head.refc, refc); + erts_smp_atomic32_init_nob(&tmr->state, ERTS_TMR_STATE_ACTIVE); + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (!srv->next_timeout + || tmr->timeout < srv->next_timeout->timeout) { + if (srv->next_timeout) + erts_twheel_cancel_timer(esdp->timer_wheel, + &srv->service_timer); + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + (void *) esdp, + tmr->timeout); + srv->next_timeout = tmr; + } + + st_tmr = time_rbt_lookup_insert(&srv->time_tree, tmr); + tmr->time.tree.same_time = st_tmr; + if (st_tmr) + same_time_list_insert(&st_tmr->time.tree.same_time, tmr); + + if (is_bif_tmr) + btm_rbt_insert(&srv->btm_tree, tmr); + +#ifdef ERTS_HLT_HARD_DEBUG + tmr->pending_timeout = 0; +#endif + + ERTS_HLT_HDBG_CHK_SRV(srv); + + return tmr; +} + +static ERTS_INLINE void +hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) +{ + ErtsProcLocks proc_locks = ERTS_PROC_LOCKS_MSG_SEND; + Process *proc; + int queued_message = 0; + int dec_refc = 0; + Uint32 is_reg_name = (roflgs & ERTS_TMR_ROFLG_REG_NAME); + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_BIF_TMR); + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + hlt_delete_abtm(tmr); + + if (is_reg_name) { + Eterm pid; + ERTS_HLT_ASSERT(is_atom(tmr->receiver.name)); + pid = erts_whereis_name_to_id(NULL, tmr->receiver.name); + proc = erts_proc_lookup(pid); + } + else { + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PROC); + ERTS_HLT_ASSERT(tmr->receiver.proc); + + proc = tmr->receiver.proc; + proc_locks |= ERTS_PROC_LOCK_BTM; + } + if (proc) { + erts_smp_proc_lock(proc, proc_locks); + /* + * If process is exiting, let it clean up + * the btm tree by itself (it may be in + * the middle of tree destruction). + */ + if (!ERTS_PROC_IS_EXITING(proc)) { + erts_queue_message(proc, &proc_locks, tmr->btm.bp, + tmr->btm.message, NIL); + erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND); + queued_message = 1; + proc_locks &= ~ERTS_PROC_LOCKS_MSG_SEND; + tmr->btm.bp = NULL; + if (tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + proc_btm_rbt_delete(&proc->bif_timers, tmr); + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + dec_refc = 1; + } + } + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + if (dec_refc) + hl_timer_pre_dec_refc(tmr); + } + if (!queued_message && tmr->btm.bp) + free_message_buffer(tmr->btm.bp); +} + +static ERTS_INLINE void +hlt_proc_timeout(ErtsHLTimer *tmr) +{ + if (proc_timeout_common(tmr->receiver.proc, (void *) tmr)) + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +static ERTS_INLINE void +hlt_port_timeout(ErtsHLTimer *tmr) +{ + if (port_timeout_common(tmr->receiver.port, (void *) tmr)) + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +static void hlt_timeout(ErtsHLTimer *tmr, void *vsrv) +{ + ErtsHLTimerService *srv = (ErtsHLTimerService *) vsrv; + Uint32 roflgs; + erts_aint32_t state; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + roflgs = tmr->head.roflgs; + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_HLT); + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_TIMED_OUT, + ERTS_TMR_STATE_ACTIVE); + + ERTS_HLT_ASSERT(state == ERTS_TMR_STATE_CANCELED + || state == ERTS_TMR_STATE_ACTIVE); + + if (state == ERTS_TMR_STATE_ACTIVE) { + + if (roflgs & ERTS_TMR_ROFLG_BIF_TMR) + hlt_bif_timer_timeout(tmr, roflgs); + else if (roflgs & ERTS_TMR_ROFLG_PROC) + hlt_proc_timeout(tmr); + else { + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PORT); + hlt_port_timeout(tmr); + } + } + + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + if ((roflgs & ERTS_TMR_ROFLG_BIF_TMR) + && tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + btm_rbt_delete(&srv->btm_tree, tmr); + tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + + ERTS_HLT_HDBG_CHK_SRV(srv); + + hl_timer_dec_refc(tmr, roflgs); +} + +#ifdef ERTS_HLT_HARD_DEBUG +static void +set_pending_timeout(ErtsHLTimer *tmr, void *unused) +{ + tmr->pending_timeout = -1; +} +#endif + +static void +hlt_service_timeout(void *vesdp) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ErtsHLTimerService *srv = esdp->timer_service; + ErtsHLTimer *tmr = srv->next_timeout; + int yield; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + + ERTS_HLT_ASSERT(!srv->yield.root || srv->yield.root == tmr); + ERTS_HLT_ASSERT(tmr); + ERTS_HLT_ASSERT(tmr->timeout <= erts_get_monotonic_time(esdp)); + + if (!srv->yield.root) { + ERTS_HLT_ASSERT(tmr->time.tree.parent + != ERTS_HLT_PFIELD_NOT_IN_TABLE); + time_rbt_delete(&srv->time_tree, tmr); + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; +#ifdef ERTS_HLT_HARD_DEBUG + tmr->pending_timeout = 1; + if (tmr->time.tree.same_time) + same_time_list_foreach(tmr->time.tree.same_time, set_pending_timeout, NULL); +#endif + } + + if (!tmr->time.tree.same_time && !srv->yield.root) + yield = 0; + else { + yield = same_time_list_foreach_destroy_yielding( + &tmr->time.tree.same_time, hlt_timeout, (void *) srv, + &srv->yield.state, ERTS_TMR_TIMEOUT_YIELD_LIMIT); + } + + if (yield) + srv->yield.root = tmr; + else { + srv->yield.root = NULL; + hlt_timeout(tmr, (void *) srv); + + tmr = time_rbt_smallest(srv->time_tree); + srv->next_timeout = tmr; + } + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (tmr) + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + vesdp, + tmr->timeout); +} + +static void +hlt_delete_timer(ErtsSchedulerData *esdp, ErtsHLTimer *tmr) +{ + ErtsHLTimerService *srv = esdp->timer_service; + + ERTS_HLT_HDBG_CHK_SRV(srv); + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR) { + + if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + btm_rbt_delete(&srv->btm_tree, tmr); + tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + } + + if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) + hlt_delete_abtm(tmr); + } + + if (tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE) { + /* Already removed... */ + ERTS_HLT_HDBG_CHK_SRV(srv); + return; + } + + if (tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) { + same_time_list_delete(tmr); + } + else if (tmr->time.tree.same_time) { + ErtsHLTimer *st_container; + + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + st_container = tmr->time.tree.same_time->time.tree.u.l.prev; + + ERTS_HLT_ASSERT(st_container); + ERTS_HLT_ASSERT(st_container->time.tree.parent + & ERTS_HLT_PFLG_SAME_TIME); + ERTS_HLT_ASSERT(tmr->timeout == st_container->timeout); + + same_time_list_delete(st_container); + st_container->time.tree.same_time = tmr->time.tree.same_time; + same_time_list_new_root(&st_container->time.tree.same_time); + + time_rbt_replace(&srv->time_tree, tmr, st_container); + ERTS_HLT_ASSERT((st_container->time.tree.parent + & ERTS_HLT_PFLG_SAME_TIME) == 0); + + if (srv->next_timeout == tmr) + srv->next_timeout = st_container; + } + else { + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + time_rbt_delete(&srv->time_tree, tmr); + if (tmr == srv->next_timeout) { + ErtsHLTimer *smlst; + erts_twheel_cancel_timer(esdp->timer_wheel, + &srv->service_timer); + smlst = time_rbt_smallest(srv->time_tree); + srv->next_timeout = smlst; + if (smlst) { + ERTS_HLT_ASSERT(smlst->timeout > tmr->timeout); + erts_twheel_set_timer(esdp->timer_wheel, + &srv->service_timer, + hlt_service_timeout, + NULL, + (void *) esdp, + smlst->timeout); + } + } + } + tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + + hl_timer_dec_refc(tmr, tmr->head.roflgs); + + ERTS_HLT_HDBG_CHK_SRV(srv); +} + +/* + * Pass canceled timers back to originating scheduler + */ + +static ERTS_INLINE void +cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp, + ErtsTimer *tmr) +{ + Uint32 roflgs = tmr->head.roflgs; + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK) + == (Uint32) esdp->no); + if (roflgs & ERTS_TMR_ROFLG_HLT) { + hlt_delete_timer(esdp, &tmr->hlt); + hl_timer_dec_refc(&tmr->hlt, roflgs); + } + else { + cancel_tw_timer(esdp, &tmr->twt); + tw_timer_dec_refc(&tmr->twt); + } +} + +#ifdef ERTS_SMP + +static void +init_canceled_queue(ErtsHLTCncldTmrQ *cq) +{ + erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL); + erts_atomic_init_nob(&cq->tail.data.last, + (erts_aint_t) &cq->tail.data.marker); + cq->head.first = (ErtsTimer *) &cq->tail.data.marker; + cq->head.unref_end = (ErtsTimer *) &cq->tail.data.marker; + cq->head.next.thr_progress = erts_thr_progress_current(); + cq->head.next.thr_progress_reached = 1; + cq->head.next.unref_end = (ErtsTimer *) &cq->tail.data.marker; + cq->head.used_marker = 1; +} + +static ERTS_INLINE int +cq_enqueue(ErtsHLTCncldTmrQ *cq, ErtsTimer *tmr, int cinit) +{ + erts_aint_t itmp; + ErtsTimer *enq, *this = tmr; + + erts_atomic_init_nob(&this->head.u.next, ERTS_AINT_NULL); + /* Enqueue at end of list... */ + + enq = (ErtsTimer *) erts_atomic_read_nob(&cq->tail.data.last); + itmp = erts_atomic_cmpxchg_relb(&enq->head.u.next, + (erts_aint_t) this, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) { + /* We are required to move last pointer */ +#ifdef DEBUG + ASSERT(ERTS_AINT_NULL == erts_atomic_read_nob(&this->head.u.next)); + ASSERT(((erts_aint_t) enq) + == erts_atomic_xchg_relb(&cq->tail.data.last, + (erts_aint_t) this)); +#else + erts_atomic_set_relb(&cq->tail.data.last, (erts_aint_t) this); +#endif + return 1; + } + else { + /* + * We *need* to insert element somewhere in between the + * last element we read earlier and the actual last element. + */ + int i = cinit; + + while (1) { + erts_aint_t itmp2; + erts_atomic_set_nob(&this->head.u.next, itmp); + itmp2 = erts_atomic_cmpxchg_relb(&enq->head.u.next, + (erts_aint_t) this, + itmp); + if (itmp == itmp2) + return 0; /* inserted this */ + if ((i & 1) == 0) + itmp = itmp2; + else { + enq = (ErtsTimer *) itmp2; + itmp = erts_atomic_read_acqb(&enq->head.u.next); + ASSERT(itmp != ERTS_AINT_NULL); + } + i++; + } + } +} + +static ERTS_INLINE erts_aint_t +check_insert_marker(ErtsHLTCncldTmrQ *cq, erts_aint_t ilast) +{ + if (!cq->head.used_marker + && cq->head.unref_end == (ErtsTimer *) ilast) { + erts_aint_t itmp; + ErtsTimer *last = (ErtsTimer *) ilast; + + erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL); + itmp = erts_atomic_cmpxchg_relb(&last->head.u.next, + (erts_aint_t) &cq->tail.data.marker, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) { + ilast = (erts_aint_t) &cq->tail.data.marker; + cq->head.used_marker = !0; + erts_atomic_set_relb(&cq->tail.data.last, ilast); + } + } + return ilast; +} + +static ERTS_INLINE ErtsTimer * +cq_dequeue(ErtsHLTCncldTmrQ *cq) +{ + ErtsTimer *tmr; + + if (cq->head.first == cq->head.unref_end) + return NULL; + + tmr = cq->head.first; + if (tmr == (ErtsTimer *) &cq->tail.data.marker) { + ASSERT(cq->head.used_marker); + cq->head.used_marker = 0; + tmr = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next); + if (tmr == cq->head.unref_end) { + cq->head.first = tmr; + return NULL; + } + } + + cq->head.first = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next); + + ASSERT(cq->head.first); + + return tmr; +} + +static int +cq_check_incoming(ErtsSchedulerData *esdp, ErtsHLTCncldTmrQ *cq) +{ + erts_aint_t ilast = erts_atomic_read_nob(&cq->tail.data.last); + if (((ErtsTimer *) ilast) == (ErtsTimer *) &cq->tail.data.marker + && cq->head.first == (ErtsTimer *) &cq->tail.data.marker) { + /* Nothing more to do... */ + return 0; + } + + if (cq->head.next.thr_progress_reached + || erts_thr_progress_has_reached(cq->head.next.thr_progress)) { + cq->head.next.thr_progress_reached = 1; + /* Move unreferenced end pointer forward... */ + + ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore; + + cq->head.unref_end = cq->head.next.unref_end; + + ilast = check_insert_marker(cq, ilast); + + if (cq->head.unref_end != (ErtsTimer *) ilast) { + cq->head.next.unref_end = (ErtsTimer *) ilast; + cq->head.next.thr_progress = erts_thr_progress_later(esdp); + cq->head.next.thr_progress_reached = 0; + } + } + return 1; +} + +static ERTS_INLINE void +store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsHLTCncldTmrQ *cq) +{ + if (!cq->head.next.thr_progress_reached + && (*prev_val == ERTS_THR_PRGR_INVALID + || erts_thr_progress_cmp(cq->head.next.thr_progress, + *prev_val) < 0)) { + *prev_val = cq->head.next.thr_progress; + } +} + +static void +handle_canceled_queue(ErtsSchedulerData *esdp, + ErtsHLTCncldTmrQ *cq, + int use_limit, + int ops_limit, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work) +{ + int need_thr_prgr = 0; + int need_mr_wrk = 0; + int have_checked_incoming = 0; + int ops = 0; + + ERTS_HLT_ASSERT(cq == &esdp->timer_service->canceled_queue); + + while (1) { + ErtsTimer *tmr = cq_dequeue(cq); + + if (tmr) + cleanup_sched_local_canceled_timer(esdp, tmr); + else { + if (have_checked_incoming) + break; + need_thr_prgr = cq_check_incoming(esdp, cq); + if (need_thr_progress) { + *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, cq); + } + have_checked_incoming = 1; + continue; + } + + if (use_limit && ++ops >= ops_limit) { + if (cq->head.first != cq->head.unref_end) { + need_mr_wrk = 1; + if (need_more_work) + *need_more_work |= 1; + } + break; + } + } + + if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) { + need_thr_prgr = cq_check_incoming(esdp, cq); + *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, cq); + } +} + +void +erts_handle_canceled_timers(void *vesdp, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + + handle_canceled_queue(esdp, &esdp->timer_service->canceled_queue, + 1, ERTS_TMR_CANCELED_TIMER_LIMIT, + need_thr_progress, thr_prgr_p, + need_more_work); +} + +#endif /* ERTS_SMP */ + +static void +queue_canceled_timer(ErtsSchedulerData *esdp, int rsched_id, ErtsTimer *tmr) +{ +#ifdef ERTS_SMP + ErtsHLTCncldTmrQ *cq; + cq = &ERTS_SCHEDULER_IX(rsched_id-1)->timer_service->canceled_queue; + if (cq_enqueue(cq, tmr, rsched_id - (int) esdp->no)) + erts_notify_canceled_timer(esdp, rsched_id); +#else + ERTS_INTERNAL_ERROR("Unexpected enqueue of canceled timer"); +#endif +} + +static void +continue_cancel_ptimer(ErtsSchedulerData *esdp, ErtsTimer *tmr) +{ +#ifdef ERTS_SMP + Uint32 sid = (tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK); + + if (esdp->no != sid) + queue_canceled_timer(esdp, sid, tmr); + else +#endif + cleanup_sched_local_canceled_timer(esdp, tmr); +} + +/* + * BIF timer specific + */ + +Uint erts_bif_timer_memory_size(void) +{ + return (Uint) 0; +} + +static BIF_RETTYPE +setup_bif_timer(Process *c_p, ErtsMonotonicTime timeout_pos, + int short_time, Eterm rcvr, Eterm acsr, + Eterm msg, int wrap) +{ + BIF_RETTYPE ret; + Eterm ref, tmo_msg, *hp; + ErtsHLTimer *tmr; + ErtsSchedulerData *esdp; + DeclareTmpHeap(tmp_hp, 4, c_p); + + if (is_not_internal_pid(rcvr) && is_not_atom(rcvr)) + goto badarg; + + esdp = ERTS_PROC_GET_SCHDATA(c_p); + + hp = HAlloc(c_p, REF_THING_SIZE); + ref = erts_sched_make_ref_in_buffer(esdp, hp); + + ASSERT(erts_get_ref_numbers_thr_id( + internal_ref_numbers(ref)) == (Uint32) esdp->no); + + UseTmpHeap(4, c_p); + + tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg; + + tmr = create_hl_timer(esdp, timeout_pos, short_time, 1, NULL, + rcvr, acsr, tmo_msg, internal_ref_numbers(ref)); + + UnUseTmpHeap(4, c_p); + + if (is_internal_pid(rcvr)) { + Process *proc = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + rcvr, ERTS_PROC_LOCK_BTM, + ERTS_P2P_FLG_INC_REFC); + if (!proc) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + hlt_delete_timer(esdp, tmr); + hl_timer_destroy(tmr); + } + else { + proc_btm_rbt_insert(&proc->bif_timers, tmr); + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + tmr->receiver.proc = proc; + } + } + + ERTS_BIF_PREP_RET(ret, ref); + return ret; + +badarg: + + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + return ret; +} + +static int +cancel_bif_timer(ErtsHLTimer *tmr) +{ + erts_aint_t state; + Uint32 roflgs; + int res; + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_CANCELED, + ERTS_TMR_STATE_ACTIVE); + if (state != ERTS_TMR_STATE_ACTIVE) + return 0; + + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + + res = -1; + + roflgs = tmr->head.roflgs; + if (roflgs & ERTS_TMR_ROFLG_PROC) { + Process *proc = tmr->receiver.proc; + ERTS_HLT_ASSERT(!(tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME)); + + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM); + /* + * If process is exiting, let it clean up + * the btm tree by itself (it may be in + * the middle of tree destruction). + */ + if (!ERTS_PROC_IS_EXITING(proc) + && tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { + proc_btm_rbt_delete(&proc->bif_timers, tmr); + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + res = 1; + } + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + } + + return res; +} + +static ERTS_INLINE Eterm +access_sched_local_btm(Process *c_p, Eterm pid, + Eterm tref, Uint32 *trefn, + Uint32 *rrefn, + int async, int cancel, + int return_res, + int info) +{ + ErtsSchedulerData *esdp; + ErtsHLTimerService *srv; + ErtsHLTimer *tmr; + Sint64 time_left; + Process *proc; + ErtsProcLocks proc_locks; + + time_left = -1; + + if (!c_p) + esdp = erts_get_scheduler_data(); + else { + esdp = ERTS_PROC_GET_SCHDATA(c_p); + ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data()); + } + + ERTS_HLT_ASSERT(erts_get_ref_numbers_thr_id(trefn) + == (Uint32) esdp->no); + + srv = esdp->timer_service; + + tmr = btm_rbt_lookup(srv->btm_tree, trefn); + if (tmr) { + if (!cancel) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->state); + if (state == ERTS_TMR_STATE_ACTIVE) + time_left = get_time_left(esdp, tmr->timeout); + } + else { + int cncl_res = cancel_bif_timer(tmr); + if (cncl_res) { + + time_left = get_time_left(esdp, tmr->timeout); + + if (cncl_res > 0) + hl_timer_dec_refc(tmr, tmr->head.roflgs); + + hlt_delete_timer(esdp, tmr); + } + } + } + + if (!info) + return am_ok; + + if (return_res) { + ERTS_HLT_ASSERT(c_p); + if (time_left < 0) + return am_false; + else if (time_left <= (Sint64) MAX_SMALL) + return make_small((Sint) time_left); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(time_left); + Eterm *hp = HAlloc(c_p, hsz); + return erts_sint64_to_big(time_left, &hp); + } + } + + if (c_p) { + proc = c_p; + proc_locks = ERTS_PROC_LOCK_MAIN; + } + else { + proc = erts_proc_lookup(pid); + proc_locks = 0; + } + + if (proc) { + Uint hsz; + ErlOffHeap *ohp; + ErlHeapFragment* bp; + Eterm *hp, msg, ref, result; +#ifdef ERTS_HLT_DEBUG + Eterm *hp_end; +#endif + + hsz = 3; /* 2-tuple */ + if (!async) + hsz += REF_THING_SIZE; + else { + if (is_non_value(tref) || proc != c_p) + hsz += REF_THING_SIZE; + hsz += 1; /* upgrade to 3-tuple */ + } + if (time_left > (Sint64) MAX_SMALL) + hsz += ERTS_SINT64_HEAP_SIZE(time_left); + + if (proc == c_p) { + bp = NULL; + ohp = NULL; + hp = HAlloc(c_p, hsz); + } + else { + hp = erts_alloc_message_heap(hsz, + &bp, + &ohp, + proc, + &proc_locks); + } + +#ifdef ERTS_HLT_DEBUG + hp_end = hp + hsz; +#endif + + if (time_left < 0) + result = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + result = make_small((Sint) time_left); + else + result = erts_sint64_to_big(time_left, &hp); + + if (!async) { + write_ref_thing(hp, + rrefn[0], + rrefn[1], + rrefn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; + msg = TUPLE2(hp, ref, result); + + ERTS_HLT_ASSERT(hp + 3 == hp_end); + } + else { + Eterm tag = cancel ? am_cancel_timer : am_read_timer; + if (is_value(tref) && proc == c_p) + ref = tref; + else { + write_ref_thing(hp, + trefn[0], + trefn[1], + trefn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; + } + msg = TUPLE3(hp, tag, ref, result); + + ERTS_HLT_ASSERT(hp + 4 == hp_end); + + } + erts_queue_message(proc, &proc_locks, bp, msg, NIL); + + if (c_p) + proc_locks &= ~ERTS_PROC_LOCK_MAIN; + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + } + + return am_ok; +} + +#define ERTS_BTM_REQ_FLG_ASYNC (((Uint32) 1) << 0) +#define ERTS_BTM_REQ_FLG_CANCEL (((Uint32) 1) << 1) +#define ERTS_BTM_REQ_FLG_INFO (((Uint32) 1) << 2) + +typedef struct { + Eterm pid; + Uint32 trefn[ERTS_REF_NUMBERS]; + Uint32 rrefn[ERTS_REF_NUMBERS]; + Uint32 flags; +} ErtsBifTimerRequest; + +static void +bif_timer_access_request(void *vreq) +{ + ErtsBifTimerRequest *req = (ErtsBifTimerRequest *) vreq; + int async = (int) (req->flags & ERTS_BTM_REQ_FLG_ASYNC); + int cancel = (int) (req->flags & ERTS_BTM_REQ_FLG_CANCEL); + int info = (int) (req->flags & ERTS_BTM_REQ_FLG_INFO); + (void) access_sched_local_btm(NULL, req->pid, THE_NON_VALUE, + req->trefn, req->rrefn, async, + cancel, 0, info); + erts_free(ERTS_ALC_T_TIMER_REQUEST, vreq); +} + +static int +try_access_sched_remote_btm(ErtsSchedulerData *esdp, + Process *c_p, Uint32 sid, + Eterm tref, Uint32 *trefn, + int async, int cancel, + int info, Eterm *resp) +{ + ErtsHLTimer *tmr; + Sint64 time_left; + + ERTS_HLT_ASSERT(c_p); + + /* + * Check if the timer is aimed at current + * process of if this process is an accessor + * of the timer... + */ + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_BTM); + tmr = proc_btm_rbt_lookup(c_p->bif_timers, trefn); + if (!tmr) + tmr = abtm_rbt_lookup(c_p->accessor_bif_timers, trefn); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_BTM); + if (!tmr) + return 0; + + if (!cancel) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->state); + if (state == ERTS_TMR_STATE_ACTIVE) + time_left = get_time_left(esdp, tmr->timeout); + else + time_left = -1; + } + else { + int cncl_res = cancel_bif_timer(tmr); + if (!cncl_res) + time_left = -1; + else { + time_left = get_time_left(esdp, tmr->timeout); + if (cncl_res > 0) + queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); + } + } + + if (!info) { + *resp = am_ok; + return 1; + } + + if (!async) { + if (time_left < 0) + *resp = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + *resp = make_small((Sint) time_left); + else { + Uint hsz = ERTS_SINT64_HEAP_SIZE(time_left); + Eterm *hp = HAlloc(c_p, hsz); + *resp = erts_sint64_to_big(time_left, &hp); + } + } + else { + Eterm tag, res, msg; + Uint hsz; + Eterm *hp; + ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; + + hsz = 4; + if (time_left > (Sint64) MAX_SMALL) + hsz += ERTS_SINT64_HEAP_SIZE(time_left); + + hp = HAlloc(c_p, hsz); + if (cancel) + tag = am_cancel_timer; + else + tag = am_read_timer; + + if (time_left < 0) + res = am_false; + else if (time_left <= (Sint64) MAX_SMALL) + res = make_small((Sint) time_left); + else + res = erts_sint64_to_big(time_left, &hp); + + msg = TUPLE3(hp, tag, tref, res); + + erts_queue_message(c_p, &proc_locks, NULL, msg, NIL); + + proc_locks &= ~ERTS_PROC_LOCK_MAIN; + if (proc_locks) + erts_smp_proc_unlock(c_p, proc_locks); + + *resp = am_ok; + } + return 1; +} + +static BIF_RETTYPE +access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) +{ + BIF_RETTYPE ret; + ErtsSchedulerData *esdp; + Uint32 sid; + Uint32 *trefn; + Eterm res; + + if (is_not_internal_ref(tref)) { + if (is_not_ref(tref)) + goto badarg; + else + goto no_timer; + } + + esdp = ERTS_PROC_GET_SCHDATA(c_p); + + trefn = internal_ref_numbers(tref); + sid = erts_get_ref_numbers_thr_id(trefn); + if (sid < 1 || erts_no_schedulers < sid) + goto no_timer; + + if (sid == (Uint32) esdp->no) { + res = access_sched_local_btm(c_p, c_p->common.id, + tref, trefn, NULL, + async, cancel, !async, + info); + ERTS_BIF_PREP_RET(ret, res); + } + else if (try_access_sched_remote_btm(esdp, c_p, sid, + tref, trefn, + async, cancel, + info, &res)) { + ERTS_BIF_PREP_RET(ret, res); + } + else { + /* + * Schedule access for execution on + * remote scheduler... + */ + ErtsBifTimerRequest *req = erts_alloc(ERTS_ALC_T_TIMER_REQUEST, + sizeof(ErtsBifTimerRequest)); + + req->flags = 0; + if (cancel) + req->flags |= ERTS_BTM_REQ_FLG_CANCEL; + if (async) + req->flags |= ERTS_BTM_REQ_FLG_ASYNC; + if (info) + req->flags |= ERTS_BTM_REQ_FLG_INFO; + + req->pid = c_p->common.id; + + req->trefn[0] = trefn[0]; + req->trefn[1] = trefn[1]; + req->trefn[2] = trefn[2]; + + if (async) + ERTS_BIF_PREP_RET(ret, am_ok); + else { + Eterm *hp, rref; + Uint32 *rrefn; + + hp = HAlloc(c_p, REF_THING_SIZE); + rref = erts_sched_make_ref_in_buffer(esdp, hp); + rrefn = internal_ref_numbers(rref); + + req->rrefn[0] = rrefn[0]; + req->rrefn[1] = rrefn[1]; + req->rrefn[2] = rrefn[2]; + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + + if (ERTS_PROC_PENDING_EXIT(c_p)) + ERTS_VBUMP_ALL_REDS(c_p); + else { + /* + * Caller needs to wait for a message containing + * the ref that we just created. No such message + * can exist in callers message queue at this time. + * We therefore move the save pointer of the + * callers message queue to the end of the queue. + * + * NOTE: It is of vital importance that the caller + * immediately do a receive unconditionaly + * waiting for the message with the reference; + * otherwise, next receive will *not* work + * as expected! + */ + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + c_p->msg.save = c_p->msg.last; + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + + ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, rref); + } + + erts_schedule_misc_aux_work(sid, + bif_timer_access_request, + (void *) req); + } + + return ret; + +badarg: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + return ret; + +no_timer: + ERTS_BIF_PREP_RET(ret, am_false); + return ret; + +} + +static ERTS_INLINE int +bool_arg(Eterm val, int *argp) +{ + switch (val) { + case am_true: *argp = 1; return 1; + case am_false: *argp = 0; return 1; + default: return 0; + } +} + +static ERTS_INLINE int +parse_bif_timer_options(Eterm option_list, int *async, int *info, + int *abs, Eterm *accessor) +{ + Eterm list = option_list; + + if (async) + *async = 0; + if (info) + *info = 1; + if (abs) + *abs = 0; + if (accessor) + *accessor = THE_NON_VALUE; + + while (is_list(list)) { + Eterm *consp, *tp, opt; + + consp = list_val(list); + opt = CAR(consp); + if (is_not_tuple(opt)) + return 0; + + tp = tuple_val(opt); + if (arityval(tp[0]) != 2) + return 0; + + switch (tp[1]) { + case am_async: + if (!async || !bool_arg(tp[2], async)) + return 0; + break; + case am_info: + if (!info || !bool_arg(tp[2], info)) + return 0; + break; + case am_abs: + if (!abs || !bool_arg(tp[2], abs)) + return 0; + break; + case am_accessor: + if (!accessor || is_not_internal_pid(tp[2])) + return 0; + *accessor = tp[2]; + break; + default: + return 0; + } + + list = CDR(consp); + } + + if (is_not_nil(list)) + return 0; + return 1; +} + +static void +exit_cancel_bif_timer(ErtsHLTimer *tmr, void *vesdp) +{ + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + Uint32 sid, roflgs; + erts_aint_t state; + + state = erts_smp_atomic32_cmpxchg_acqb(&tmr->state, + ERTS_TMR_STATE_CANCELED, + ERTS_TMR_STATE_ACTIVE); + + roflgs = tmr->head.roflgs; + sid = roflgs & ERTS_TMR_ROFLG_SID_MASK; + + ERTS_HLT_ASSERT(sid == erts_get_ref_numbers_thr_id(tmr->btm.refn)); + ERTS_HLT_ASSERT(tmr->btm.proc_tree.parent + != ERTS_HLT_PFIELD_NOT_IN_TABLE); + + tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + + if (sid == (Uint32) esdp->no) { + if (state == ERTS_TMR_STATE_ACTIVE) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + hlt_delete_timer(esdp, tmr); + } + hl_timer_dec_refc(tmr, roflgs); + } + else { + if (state == ERTS_TMR_STATE_ACTIVE) { + if (tmr->btm.bp) + free_message_buffer(tmr->btm.bp); + queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); + } + else + hl_timer_dec_refc(tmr, roflgs); + } +} + +#ifdef ERTS_HLT_DEBUG +# define ERTS_BTM_MAX_DESTROY_LIMIT 2 +#else +# define ERTS_BTM_MAX_DESTROY_LIMIT 50 +#endif + +typedef struct { + ErtsBifTimers *bif_timers; + union { + proc_btm_rbt_yield_state_t proc_btm_yield_state; + abtm_rbt_yield_state_t abtm_yield_state; + } u; +} ErtsBifTimerYieldState; + +int erts_cancel_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(p); + ErtsBifTimerYieldState ys = {btm, {ERTS_RBT_YIELD_STAT_INITER}}; + ErtsBifTimerYieldState *ysp; + int res; + + ysp = (ErtsBifTimerYieldState *) *vyspp; + if (!ysp) + ysp = &ys; + + res = proc_btm_rbt_foreach_destroy_yielding(&ysp->bif_timers, + exit_cancel_bif_timer, + (void *) esdp, + &ysp->u.proc_btm_yield_state, + ERTS_BTM_MAX_DESTROY_LIMIT); + + if (res == 0) { + if (ysp != &ys) + erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp); + *vyspp = NULL; + } + else { + + if (ysp == &ys) { + ysp = erts_alloc(ERTS_ALC_T_BTM_YIELD_STATE, + sizeof(ErtsBifTimerYieldState)); + sys_memcpy((void *) ysp, (void *) &ys, + sizeof(ErtsBifTimerYieldState)); + } + + *vyspp = (void *) ysp; + } + + return res; +} + +static void +detach_bif_timer(ErtsHLTimer *tmr, void *vesdp) +{ + tmr->abtm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + hl_timer_dec_refc(tmr, tmr->head.roflgs); +} + +int erts_detach_accessor_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(p); + ErtsBifTimerYieldState ys = {btm, {ERTS_RBT_YIELD_STAT_INITER}}; + ErtsBifTimerYieldState *ysp; + int res; + + ysp = (ErtsBifTimerYieldState *) *vyspp; + if (!ysp) + ysp = &ys; + + res = abtm_rbt_foreach_destroy_yielding(&ysp->bif_timers, + detach_bif_timer, + (void *) esdp, + &ysp->u.abtm_yield_state, + ERTS_BTM_MAX_DESTROY_LIMIT); + + if (res == 0) { + if (ysp != &ys) + erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp); + *vyspp = NULL; + } + else { + + if (ysp == &ys) { + ysp = erts_alloc(ERTS_ALC_T_BTM_YIELD_STATE, + sizeof(ErtsBifTimerYieldState)); + sys_memcpy((void *) ysp, (void *) &ys, + sizeof(ErtsBifTimerYieldState)); + } + + *vyspp = (void *) ysp; + } + + return res; +} + +static ERTS_INLINE int +parse_timeout_pos(ErtsSchedulerData *esdp, Eterm arg, + ErtsMonotonicTime *conv_arg, int abs, + ErtsMonotonicTime *tposp, int *stimep) +{ + ErtsMonotonicTime t; + + if (!term_to_Sint64(arg, &t)) { + ERTS_HLT_ASSERT(!is_small(arg)); + if (!is_big(arg)) + return -1; + + if (abs || !big_sign(arg)) + return 1; + + return -1; + } + + if (conv_arg) + *conv_arg = t; + + if (abs) { + t += -1*ERTS_MONOTONIC_OFFSET_MSEC; /* external to internal */ + if (t < ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_BEGIN)) + return 1; + if (t > ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_END)) + return 1; + *stimep = (t - ERTS_MONOTONIC_TO_MSEC(esdp->last_monotonic_time) + < ERTS_BIF_TIMER_SHORT_TIME); + *tposp = ERTS_MSEC_TO_CLKTCKS(t); + } + else { + ErtsMonotonicTime now, ticks; + + if (t < 0) + return -1; + + ticks = ERTS_MSEC_TO_CLKTCKS(t); + + if (ERTS_CLKTCK_RESOLUTION > 1000 && ticks < 0) + return 1; + + ERTS_HLT_ASSERT(ticks >= 0); + + now = erts_get_monotonic_time(esdp); + ticks += ERTS_MONOTONIC_TO_CLKTCKS(now-1); + ticks += 1; + + if (ticks < ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_BEGIN)) + return 1; + if (ticks > ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_END)) + return 1; + + *stimep = (t < ERTS_BIF_TIMER_SHORT_TIME); + *tposp = ticks; + } + + return 0; +} + +/* + * + * The BIF timer BIFs... + */ + +BIF_RETTYPE send_after_3(BIF_ALIST_3) +{ + ErtsMonotonicTime timeout_pos; + int short_time, tres; + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + 0, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, BIF_ARG_2, BIF_ARG_3, 0); +} + +BIF_RETTYPE send_after_4(BIF_ALIST_4) +{ + ErtsMonotonicTime timeout_pos; + Eterm accessor; + int short_time, abs, tres; + + if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs, &accessor)) + BIF_ERROR(BIF_P, BADARG); + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + abs, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, accessor, BIF_ARG_3, 0); +} + +BIF_RETTYPE start_timer_3(BIF_ALIST_3) +{ + ErtsMonotonicTime timeout_pos; + int short_time, tres; + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + 0, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, BIF_ARG_2, BIF_ARG_3, !0); +} + +BIF_RETTYPE start_timer_4(BIF_ALIST_4) +{ + ErtsMonotonicTime timeout_pos; + Eterm accessor; + int short_time, abs, tres; + + if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs, &accessor)) + BIF_ERROR(BIF_P, BADARG); + + tres = parse_timeout_pos(ERTS_PROC_GET_SCHDATA(BIF_P), BIF_ARG_1, NULL, + abs, &timeout_pos, &short_time); + if (tres != 0) + BIF_ERROR(BIF_P, BADARG); + + return setup_bif_timer(BIF_P, timeout_pos, short_time, + BIF_ARG_2, accessor, BIF_ARG_3, !0); +} + +BIF_RETTYPE cancel_timer_1(BIF_ALIST_1) +{ + return access_bif_timer(BIF_P, BIF_ARG_1, 1, 0, 1); +} + +BIF_RETTYPE cancel_timer_2(BIF_ALIST_2) +{ + BIF_RETTYPE ret; + int async, info; + + if (parse_bif_timer_options(BIF_ARG_2, &async, &info, NULL, NULL)) + return access_bif_timer(BIF_P, BIF_ARG_1, 1, async, info); + + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + return ret; +} + +BIF_RETTYPE read_timer_1(BIF_ALIST_1) +{ + return access_bif_timer(BIF_P, BIF_ARG_1, 0, 0, 1); +} + +BIF_RETTYPE read_timer_2(BIF_ALIST_2) +{ + BIF_RETTYPE ret; + int async; + + if (parse_bif_timer_options(BIF_ARG_2, &async, NULL, NULL, NULL)) + return access_bif_timer(BIF_P, BIF_ARG_1, 0, async, 1); + + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + return ret; +} + +/* + * Process and Port timer functionality. + * + * NOTE! These are only allowed to be called by a + * scheduler thread that currently is + * executing the process or port. + */ + +static ERTS_INLINE void +set_proc_timer_common(Process *c_p, ErtsSchedulerData *esdp, Sint64 tmo, + ErtsMonotonicTime timeout_pos, int short_time) +{ + void *tmr; + check_canceled_queue(esdp, esdp->timer_service); + + if (tmo == 0) + c_p->flags |= F_TIMO; + else { + + c_p->flags |= F_INSLPQUEUE; + c_p->flags &= ~F_TIMO; + + if (tmo < ERTS_TIMER_WHEEL_MSEC) + tmr = (void *) create_tw_timer(esdp, (void *) c_p, 1, timeout_pos); + else + tmr = (void *) create_hl_timer(esdp, timeout_pos, + short_time, 0, (void *) c_p, + c_p->common.id, NIL, NIL, NULL); + erts_smp_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr); + } +} + +int +erts_set_proc_timer_term(Process *c_p, Eterm etmo) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + ErtsMonotonicTime tmo, timeout_pos; + int short_time, tres; + + ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer) + == ERTS_PTMR_NONE); + + tres = parse_timeout_pos(esdp, etmo, &tmo, 0, + &timeout_pos, &short_time); + if (tres != 0) + return tres; + + if ((tmo >> 32) != 0) + return 1; + + set_proc_timer_common(c_p, esdp, tmo, timeout_pos, short_time); + return 0; +} + +void +erts_set_proc_timer_uword(Process *c_p, UWord tmo) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + + ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer) + == ERTS_PTMR_NONE); + +#ifndef ARCH_32 + ERTS_HLT_ASSERT((tmo >> 32) == (UWord) 0); +#endif + + if (tmo == 0) + c_p->flags |= F_TIMO; + else { + ErtsMonotonicTime timeout_pos; + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), + (ErtsMonotonicTime) tmo); + set_proc_timer_common(c_p, esdp, (ErtsMonotonicTime) tmo, + timeout_pos, + tmo < ERTS_BIF_TIMER_SHORT_TIME); + } +} + +void +erts_cancel_proc_timer(Process *c_p) +{ + erts_aint_t tval; + tval = erts_smp_atomic_xchg_acqb(&c_p->common.timer, + ERTS_PTMR_NONE); + c_p->flags &= ~(F_INSLPQUEUE|F_TIMO); + if (tval == ERTS_PTMR_NONE) + return; + if (tval == ERTS_PTMR_TIMEDOUT) { + erts_smp_atomic_set_nob(&c_p->common.timer, ERTS_PTMR_NONE); + return; + } + continue_cancel_ptimer(ERTS_PROC_GET_SCHDATA(c_p), + (ErtsTimer *) tval); +} + +void +erts_set_port_timer(Port *c_prt, Sint64 tmo) +{ + void *tmr; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ErtsMonotonicTime timeout_pos; + + if (erts_smp_atomic_read_nob(&c_prt->common.timer) != ERTS_PTMR_NONE) + erts_cancel_port_timer(c_prt); + + check_canceled_queue(esdp, esdp->timer_service); + + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), tmo); + + if (tmo < ERTS_TIMER_WHEEL_MSEC) + tmr = (void *) create_tw_timer(esdp, (void *) c_prt, 0, + timeout_pos); + else + tmr = (void *) create_hl_timer(esdp, timeout_pos, 0, 0, + (void *) c_prt, + c_prt->common.id, NIL, NIL, + NULL); + erts_smp_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr); +} + +void +erts_cancel_port_timer(Port *c_prt) +{ + erts_aint_t tval; + tval = erts_smp_atomic_xchg_acqb(&c_prt->common.timer, + ERTS_PTMR_NONE); + if (tval == ERTS_PTMR_NONE) + return; + if (tval == ERTS_PTMR_TIMEDOUT) { + while (!erts_port_task_is_scheduled(&c_prt->timeout_task)) + erts_thr_yield(); + erts_port_task_abort(&c_prt->timeout_task); + erts_smp_atomic_set_nob(&c_prt->common.timer, ERTS_PTMR_NONE); + return; + } + continue_cancel_ptimer(erts_get_scheduler_data(), + (ErtsTimer *) tval); +} + +Sint64 +erts_read_port_timer(Port *c_prt) +{ + ErtsTimer *tmr; + erts_aint_t itmr; + ErtsMonotonicTime timeout_pos; + + itmr = erts_smp_atomic_read_acqb(&c_prt->common.timer); + if (itmr == ERTS_PTMR_NONE) + return (Sint64) -1; + if (itmr == ERTS_PTMR_TIMEDOUT) + return (Sint64) 0; + tmr = (ErtsTimer *) itmr; + if (tmr->head.roflgs & ERTS_TMR_ROFLG_HLT) + timeout_pos = tmr->hlt.timeout; + else + timeout_pos = tmr->twt.tw_tmr.timeout_pos; + return get_time_left(NULL, timeout_pos); +} + +/* + * Debug stuff... + */ + +typedef struct { + int to; + void *to_arg; + ErtsMonotonicTime now; +} ErtsBTMPrint; + +static void +btm_print(ErtsHLTimer *tmr, void *vbtmp) +{ + ErtsBTMPrint *btmp = (ErtsBTMPrint *) vbtmp; + ErtsMonotonicTime left; + Eterm receiver; + + if (tmr->timeout <= btmp->now) + left = 0; + left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); + + receiver = ((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) + ? tmr->receiver.name + : tmr->receiver.proc->common.id); + + erts_print(btmp->to, btmp->to_arg, + "=timer:%T\n" + "Message: %T\n" + "Time left: %b64d\n", + receiver, + tmr->btm.message, + (Sint64) left); +} + +void +erts_print_bif_timer_info(int to, void *to_arg) +{ + ErtsBTMPrint btmp; + int six; + + if (!ERTS_IS_CRASH_DUMPING) + ERTS_INTERNAL_ERROR("Not crash dumping"); + + btmp.to = to; + btmp.to_arg = to_arg; + btmp.now = erts_get_monotonic_time(NULL); + btmp.now = ERTS_MONOTONIC_TO_CLKTCKS(btmp.now); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsHLTimerService *srv = + erts_aligned_scheduler_data[six].esd.timer_service; + btm_rbt_foreach(srv->btm_tree, btm_print, (void *) &btmp); + } +} + +typedef struct { + void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *); + void *arg; +} ErtsBTMForeachDebug; + +static void +debug_btm_foreach(ErtsHLTimer *tmr, void *vbtmfd) +{ + if (erts_smp_atomic32_read_nob(&tmr->state) == ERTS_TMR_STATE_ACTIVE) { + ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd; + (*btmfd->func)(((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) + ? tmr->receiver.name + : tmr->receiver.proc->common.id), + tmr->btm.message, + tmr->btm.bp, + btmfd->arg); + } +} + +void +erts_debug_bif_timer_foreach(void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *), + void *arg) +{ + ErtsBTMForeachDebug btmfd; + int six; + + btmfd.func = func; + btmfd.arg = arg; + + if (!erts_smp_thr_progress_is_blocking()) + ERTS_INTERNAL_ERROR("Not blocking thread progress"); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsHLTimerService *srv = + erts_aligned_scheduler_data[six].esd.timer_service; + btm_rbt_foreach(srv->btm_tree, + debug_btm_foreach, + (void *) &btmfd); + } +} + +#ifdef ERTS_HLT_HARD_DEBUG + +typedef struct { + ErtsHLTimerService *srv; + int found_root; + ErtsHLTimer **rootpp; +} ErtsHdbgHLT; + +static void +st_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer **rootpp; + ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME); + if (tmr->time.tree.parent == ERTS_HLT_PFLG_SAME_TIME) { + ERTS_HLT_ASSERT(tmr != *hdbg->rootpp); + } + else { + rootpp = (ErtsHLTimer **) (tmr->time.tree.parent + & ~ERTS_HLT_PFLG_SAME_TIME); + ERTS_HLT_ASSERT(rootpp == hdbg->rootpp); + ERTS_HLT_ASSERT(tmr == *rootpp); + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + } + ERTS_HLT_ASSERT(tmr->time.tree.u.l.next->time.tree.u.l.prev == tmr); + ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev->time.tree.u.l.next == tmr); + ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); +} + +static void +tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer *prnt; + ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + prnt = (ErtsHLTimer *) (tmr->time.tree.parent & ~ERTS_HLT_PFLGS_MASK); + if (prnt) { + ERTS_HLT_ASSERT(prnt->time.tree.u.t.left == tmr + || prnt->time.tree.u.t.right == tmr); + } + else { + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + ERTS_HLT_ASSERT(tmr == *hdbg->rootpp); + } + if (tmr->time.tree.u.t.left) { + prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.left->time.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->time.tree.u.t.right) { + prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.right->time.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); + if (tmr->time.tree.same_time) { + ErtsHdbgHLT st_hdbg; + st_hdbg.srv = hdbg->srv; + st_hdbg.found_root = 0; + st_hdbg.rootpp = &tmr->time.tree.same_time; + same_time_list_foreach(tmr->time.tree.same_time, st_hdbg_func, (void *) &st_hdbg); + ERTS_HLT_ASSERT(st_hdbg.found_root); + } +} + +static void +bt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) +{ + ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg; + ErtsHLTimer *prnt; + ERTS_HLT_ASSERT((tmr->btm.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0); + prnt = (ErtsHLTimer *) (tmr->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK); + if (prnt) { + ERTS_HLT_ASSERT(prnt->btm.tree.left == tmr + || prnt->btm.tree.right == tmr); + } + else { + ERTS_HLT_ASSERT(!hdbg->found_root); + hdbg->found_root = 1; + ERTS_HLT_ASSERT(tmr == *hdbg->rootpp); + } + if (tmr->btm.tree.left) { + prnt = (ErtsHLTimer *) (tmr->btm.tree.left->btm.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->btm.tree.right) { + prnt = (ErtsHLTimer *) (tmr->btm.tree.right->btm.tree.parent + & ~ERTS_HLT_PFLGS_MASK); + ERTS_HLT_ASSERT(tmr == prnt); + } + if (tmr->pending_timeout) { + if (tmr->pending_timeout > 0) /* container > 0 */ + ERTS_HLT_ASSERT(tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE); + else { + ERTS_HLT_ASSERT(tmr->time.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE); + ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME); + } + } + else { + ErtsHLTimer *ttmr = time_rbt_lookup(hdbg->srv->time_tree, tmr->timeout); + ERTS_HLT_ASSERT(ttmr); + if (ttmr != tmr) { + ERTS_HLT_ASSERT(ttmr->time.tree.same_time); + ERTS_HLT_ASSERT(tmr == same_time_list_lookup(ttmr->time.tree.same_time, tmr)); + } + } +} + +static void +hdbg_chk_srv(ErtsHLTimerService *srv) +{ + if (srv->time_tree) { + ErtsHdbgHLT hdbg; + hdbg.srv = srv; + hdbg.found_root = 0; + hdbg.rootpp = &srv->time_tree; + time_rbt_foreach(srv->time_tree, tt_hdbg_func, (void *) &hdbg); + ERTS_HLT_ASSERT(hdbg.found_root); + } + if (srv->btm_tree) { + ErtsHdbgHLT hdbg; + hdbg.srv = srv; + hdbg.found_root = 0; + hdbg.rootpp = &srv->btm_tree; + btm_rbt_foreach(srv->btm_tree, bt_hdbg_func, (void *) &hdbg); + ERTS_HLT_ASSERT(hdbg.found_root); + } +} + +#endif /* ERTS_HLT_HARD_DEBUG */ diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h new file mode 100644 index 0000000000..30889a71da --- /dev/null +++ b/erts/emulator/beam/erl_hl_timer.h @@ -0,0 +1,80 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_HL_TIMER_H__ +#define ERL_HL_TIMER_H__ + +typedef struct ErtsHLTimer_ ErtsBifTimers; +typedef struct ErtsHLTimerService_ ErtsHLTimerService; + +#include "sys.h" +#include "erl_process.h" +#define ERL_PORT_GET_PORT_TYPE_ONLY__ +#include "erl_port.h" +#undef ERL_PORT_GET_PORT_TYPE_ONLY__ +#include "erl_message.h" +#include "erl_alloc_types.h" + +#define ERTS_PTMR_NONE ((erts_aint_t) NULL) +#define ERTS_PTMR_TIMEDOUT (ERTS_PTMR_NONE + ((erts_aint_t) 1)) + +#define ERTS_PTMR_INIT(P) \ + erts_smp_atomic_init_nob(&(P)->common.timer, ERTS_PTMR_NONE) +#define ERTS_PTMR_IS_SET(P) \ + (ERTS_PTMR_NONE != erts_smp_atomic_read_nob(&(P)->common.timer)) +#define ERTS_PTMR_IS_TIMED_OUT(P) \ + (ERTS_PTMR_TIMEDOUT == erts_smp_atomic_read_nob(&(P)->common.timer)) + +#define ERTS_PTMR_CLEAR(P) \ + do { \ + ASSERT(ERTS_PTMR_IS_TIMED_OUT((P))); \ + erts_smp_atomic_set_nob(&(P)->common.timer, \ + ERTS_PTMR_NONE); \ + } while (0) + +size_t erts_timer_type_size(ErtsAlcType_t type); +int erts_set_proc_timer_term(Process *, Eterm); +void erts_set_proc_timer_uword(Process *, UWord); +void erts_cancel_proc_timer(Process *); +void erts_set_port_timer(Port *, Sint64); +void erts_cancel_port_timer(Port *); +Sint64 erts_read_port_timer(Port *); +int erts_cancel_bif_timers(Process *, ErtsBifTimers *, void **); +int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **); +ErtsHLTimerService *erts_create_timer_service(void); +void erts_hl_timer_init(void); + +#ifdef ERTS_SMP +void +erts_handle_canceled_timers(void *vesdp, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work); +#endif + +Uint erts_bif_timer_memory_size(void); +void erts_print_bif_timer_info(int to, void *to_arg); + +void erts_debug_bif_timer_foreach(void (*func)(Eterm, + Eterm, + ErlHeapFragment *, + void *), + void *arg); + +#endif /* ERL_HL_TIMER_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 743fd235bc..33417833a9 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; @@ -161,9 +168,6 @@ int H_MIN_SIZE; /* The minimum heap grain */ int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/ Uint32 erts_debug_flags; /* Debug flags. */ -#ifdef ERTS_OPCODE_COUNTER_SUPPORT -int count_instructions; -#endif int erts_backtrace_depth; /* How many functions to show in a backtrace * in error codes. */ @@ -188,10 +192,6 @@ 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; @@ -271,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. @@ -286,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; } @@ -302,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, @@ -318,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(); @@ -341,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(); @@ -367,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; @@ -402,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 @@ -511,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"); @@ -598,7 +625,7 @@ void erts_usage(void) erts_fprintf(stderr, "-v turn on chatty mode (GCs will be reported etc)\n"); - erts_fprintf(stderr, "-W<i|w> set error logger warnings mapping,\n"); + erts_fprintf(stderr, "-W<i|w|e> set error logger warnings mapping,\n"); erts_fprintf(stderr, " see error_logger documentation for details\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); @@ -685,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; @@ -1191,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) @@ -1223,7 +1253,7 @@ erl_start(int argc, char **argv) verbose = DEBUG_DEFAULT; #endif - erts_error_logger_warnings = am_error; + erts_error_logger_warnings = am_warning; while (i < argc) { if (argv[i][0] != '-') { @@ -1909,15 +1939,51 @@ 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; + } + } } -#ifdef ERTS_OPCODE_COUNTER_SUPPORT - else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/ - count_instructions = 1; + else { + arg = get_arg(argv[i]+2, argv[i+1], &i); + erts_fprintf(stderr, "Invalid time correnction value: %s\n", arg); + erts_usage(); } -#endif break; case 'W': arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -1925,11 +1991,12 @@ erl_start(int argc, char **argv) case 'i': erts_error_logger_warnings = am_info; break; + case 'e': + erts_error_logger_warnings = am_error; + break; case 'w': erts_error_logger_warnings = am_warning; break; - case 'e': /* The default */ - erts_error_logger_warnings = am_error; default: erts_fprintf(stderr, "unrecognized warning_map option %s\n", arg); erts_usage(); @@ -1963,6 +2030,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. */ @@ -1996,7 +2087,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(); @@ -2004,7 +2097,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(); @@ -2012,13 +2106,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_instrument.c b/erts/emulator/beam/erl_instrument.c index df7c443387..da85b86c87 100644 --- a/erts/emulator/beam/erl_instrument.c +++ b/erts/emulator/beam/erl_instrument.c @@ -1226,7 +1226,7 @@ erts_instr_init(int stat, int map_stat) mem_anchor = NULL; /* Install instrumentation functions */ - ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs)); 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 a180047f6c..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,108 +141,101 @@ 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 * return value if key *matches* a key in the map */ -int erts_maps_find(Eterm key, Eterm map, Eterm *value) { +const Eterm * +#if HALFWORD_HEAP +erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base) +#else +erts_maps_get(Eterm key, Eterm map) +#endif +{ + Uint32 hx; + if (is_flatmap_rel(map, map_base)) { + Eterm *ks, *vs; + flatmap_t *mp; + Uint n, i; + + mp = (flatmap_t *)flatmap_val_rel(map, map_base); + n = flatmap_get_size(mp); - Eterm *ks,*vs; - map_t *mp; - Uint n,i; + if (n == 0) { + return NULL; + } - mp = (map_t*)map_val(map); - n = map_get_size(mp); - ks = map_get_keys(mp); - vs = map_get_values(mp); + ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; + vs = flatmap_get_values(mp); - for( i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - *value = vs[i]; - return 1; + 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], map_base, key, NULL)) { + return &vs[i]; + } + } + return NULL; } - return 0; + 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) { if (is_map(BIF_ARG_2)) { - Eterm *hp, value,res; + Eterm *hp, res; + const Eterm *value; - if (erts_maps_find(BIF_ARG_1, BIF_ARG_2, &value)) { + value = erts_maps_get(BIF_ARG_1, BIF_ARG_2); + if (value) { hp = HAlloc(BIF_P, 3); res = make_tuple(hp); *hp++ = make_arityval(2); *hp++ = am_ok; - *hp++ = value; + *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 */ - -int erts_maps_get(Eterm key, Eterm map, Eterm *value) { - Eterm *ks,*vs; - map_t *mp; - Uint n,i; - - mp = (map_t*)map_val(map); - n = map_get_size(mp); - - if (n == 0) - return 0; - - ks = map_get_keys(mp); - vs = map_get_values(mp); - - if (is_immed(key)) { - for( i = 0; i < n; i++) { - if (ks[i] == key) { - *value = vs[i]; - return 1; - } - } - } - - for( i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - *value = vs[i]; - return 1; - } - } - return 0; -} - BIF_RETTYPE maps_get_2(BIF_ALIST_2) { if (is_map(BIF_ARG_2)) { - Eterm *hp; - Eterm value, error; - char *s_error; + const Eterm *value; - if (erts_maps_get(BIF_ARG_1, BIF_ARG_2, &value)) { - BIF_RET(value); + 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 @@ -213,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 */ @@ -240,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; +} + +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; + } - idx = size; + res = hashmap_from_unsorted_array(factory, hxns, n, reject_dupkeys); - while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; } + erts_free(ERTS_ALC_T_TMP, (void *) hxns); - 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--; + 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 + +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 } -/* maps:keys/1 - */ +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; - Sint c = 0; + 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); +} - 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); +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; - need = MAP_HEADER_SIZE + 1 + 2*(n1 + n2); + mp1 = (flatmap_t*)flatmap_val(nodeA); + mp2 = (flatmap_t*)flatmap_val(nodeB); + n1 = flatmap_get_size(mp1); + n2 = flatmap_get_size(mp2); - 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++; - } - } + need = MAP_HEADER_FLATMAP_SZ + 1 + 2 * (n1 + n2); - /* copy remaining */ - while (i1 < n1) { + 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)); - /* only allocate for values, - * assume key-tuple will be intact + 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; + } + + 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; } @@ -694,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; @@ -741,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: @@ -749,53 +1545,939 @@ 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_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 */ + } } - BIF_ERROR(BIF_P, BADARG); } -int erts_validate_and_sort_map(map_t* mp) +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 *ks = map_get_keys(mp); - Eterm *vs = map_get_values(mp); - Uint sz = map_get_size(mp); + 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_flatmap(flatmap_t* mp) +{ + Eterm *ks = flatmap_get_keys(mp); + Eterm *vs = flatmap_get_values(mp); + Uint sz = flatmap_get_size(mp); Uint ix,jx; Eterm tmp; Sint c; @@ -822,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 * @@ -829,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 cfacb2ec28..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,31 +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_find(Eterm key, Eterm map, Eterm *value); -int erts_maps_get(Eterm key, Eterm map, Eterm *value); -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); + +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 +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_math.c b/erts/emulator/beam/erl_math.c index 16d4fdc09c..9b864628db 100644 --- a/erts/emulator/beam/erl_math.c +++ b/erts/emulator/beam/erl_math.c @@ -207,6 +207,24 @@ BIF_RETTYPE math_log_1(BIF_ALIST_1) return math_call_1(BIF_P, log, BIF_ARG_1); } +#ifdef HAVE_LOG2 +static double +log2_wrapper(double x) +{ + return log2(x); +} +#else +static double +log2_wrapper(double x) +{ + return log(x) / 0.6931471805599453; /* log(2.0); */ +} +#endif + +BIF_RETTYPE math_log2_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, log2_wrapper, BIF_ARG_1); +} BIF_RETTYPE math_log10_1(BIF_ALIST_1) { 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_mtrace.c b/erts/emulator/beam/erl_mtrace.c index c8bb126687..fa1bde1c87 100644 --- a/erts/emulator/beam/erl_mtrace.c +++ b/erts/emulator/beam/erl_mtrace.c @@ -627,7 +627,7 @@ erts_mtrace_install_wrapper_functions(void) if (erts_mtrace_enabled) { int i; /* Install trace functions */ - ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); sys_memcpy((void *) real_allctrs, (void *) erts_allctrs, diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index adc3520ebb..45fc949b81 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); } @@ -447,7 +445,7 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term) int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) { - return term == THE_NON_VALUE; + return env->exception_thrown && term == THE_NON_VALUE; } int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) @@ -551,9 +549,7 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin) if (refbin == NULL) { return 0; /* The NIF must take action */ } - refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */ erts_refc_init(&refbin->refc, 1); - refbin->orig_size = (SWord) size; bin->size = size; bin->data = (unsigned char*) refbin->orig_bytes; @@ -573,7 +569,6 @@ int enif_realloc_binary(ErlNifBinary* bin, size_t size) if (!newbin) { return 0; } - newbin->orig_size = size; bin->ref_bin = newbin; bin->data = (unsigned char*) newbin->orig_bytes; bin->size = size; @@ -742,7 +737,22 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, Eterm enif_make_badarg(ErlNifEnv* env) { - BIF_ERROR(env->proc, BADARG); + return enif_raise_exception(env, am_badarg); +} + +Eterm enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason) +{ + env->exception_thrown = 1; + env->proc->fvalue = reason; + BIF_ERROR(env->proc, EXC_ERROR); +} + +int enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason) +{ + if (env->exception_thrown && reason != NULL) { + *reason = env->proc->fvalue; + } + return env->exception_thrown; } int enif_get_atom(ErlNifEnv* env, Eterm atom, char* buf, unsigned len, @@ -964,8 +974,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); @@ -978,6 +992,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); } @@ -991,6 +1007,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); } @@ -1529,12 +1547,13 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) * NIF exports need a few more items than the Export struct provides, * including the erl_module_nif* and a NIF function pointer, so the * NifExport below adds those. The Export member must be first in the - * struct. The saved_mfa, saved_argc, nif_level, alloced_argv_sz and argv - * members are used to track the MFA and arguments of the top NIF in case a - * chain of one or more enif_schedule_nif() calls results in an exception, - * since in that case the original MFA and registers have to be restored - * before returning to Erlang to ensure stacktrace information associated - * with the exception is correct. + * struct. The saved_mfa, exception_thrown, saved_argc, rootset_extra, and + * rootset members are used to track the MFA, any pending exception, and + * arguments of the top NIF in case a chain of one or more + * enif_schedule_nif() calls results in an exception, since in that case + * the original MFA and registers have to be restored before returning to + * Erlang to ensure stacktrace information associated with the exception is + * correct. */ typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); @@ -1543,25 +1562,28 @@ typedef struct { struct erl_module_nif* m; NativeFunPtr fp; Eterm saved_mfa[3]; + int exception_thrown; int saved_argc; - int alloced_argv_sz; - Eterm argv[1]; + int rootset_extra; + Eterm rootset[1]; } NifExport; /* * If a process has saved arguments, they need to be part of the GC * rootset. The function below is called from setup_rootset() in - * erl_gc.c. This function is declared in erl_process.h. + * erl_gc.c. This function is declared in erl_process.h. Any exception term + * saved in the NifExport is also made part of the GC rootset here; it + * always resides in rootset[0]. */ int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) { NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - int gc = (ep && ep->saved_argc > 0); + int gc = ep && (ep->saved_argc > 0 || ep->rootset[0] != NIL); if (gc) { - *objv = ep->argv; - *nobj = ep->saved_argc; + *objv = ep->rootset; + *nobj = 1 + ep->saved_argc; } return gc; } @@ -1573,14 +1595,14 @@ static NifExport* allocate_nif_sched_data(Process* proc, int argc) { NifExport* ep; - size_t argv_extra, total; + size_t total; int i; - argv_extra = argc > 1 ? sizeof(Eterm)*(argc-1) : 0; - total = sizeof(NifExport) + argv_extra; + total = sizeof(NifExport) + argc*sizeof(Eterm); ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); sys_memset((void*) ep, 0, total); - ep->alloced_argv_sz = argc; + ep->rootset_extra = argc; + ep->rootset[0] = NIL; for (i=0; i<ERTS_NUM_CODE_IX; i++) { ep->exp.addressv[i] = &ep->exp.code[3]; } @@ -1621,15 +1643,22 @@ init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirec ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); if (!ep) ep = allocate_nif_sched_data(proc, argc); - else if (need_save && ep->alloced_argv_sz < argc) { + else if (need_save && ep->rootset_extra < argc) { NifExport* new_ep = allocate_nif_sched_data(proc, argc); destroy_nif_export(ep); ep = new_ep; } + if (env->exception_thrown) { + ep->exception_thrown = 1; + ep->rootset[0] = env->proc->fvalue; + } else { + ep->exception_thrown = 0; + ep->rootset[0] = NIL; + } ERTS_VBUMP_ALL_REDS(proc); for (i = 0; i < argc; i++) { if (need_save) - ep->argv[i] = reg[i]; + ep->rootset[i+1] = reg[i]; reg[i] = (Eterm) argv[i]; } if (need_save) { @@ -1665,7 +1694,7 @@ restore_nif_mfa(Process* proc, NifExport* ep, int exception) proc->current[2] = ep->saved_mfa[2]; if (exception) for (i = 0; i < ep->saved_argc; i++) - reg[i] = ep->argv[i]; + reg[i] = ep->rootset[i+1]; ep->saved_argc = 0; ep->saved_mfa[0] = THE_NON_VALUE; } @@ -1690,6 +1719,7 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); + ASSERT(!ep->exception_thrown); if (ep->fp) restore_nif_mfa(proc, ep, 0); return argv[0]; @@ -1707,9 +1737,10 @@ dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); + ASSERT(ep->exception_thrown); if (ep->fp) restore_nif_mfa(proc, ep, 1); - return enif_make_badarg(env); + return enif_raise_exception(env, ep->rootset[0]); } /* @@ -1754,14 +1785,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 @@ -1835,6 +1865,7 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) NifExport* ep; ERL_NIF_TERM result; + ASSERT(!env->exception_thrown); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); ep->fp = NULL; @@ -1847,7 +1878,7 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) * which case we need to restore the original NIF MFA. */ if (ep->fp == NULL) - restore_nif_mfa(proc, ep, is_non_value(result) && proc->freason != TRAP); + restore_nif_mfa(proc, ep, env->exception_thrown); return result; } @@ -1913,29 +1944,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, @@ -1944,7 +1979,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); @@ -1958,10 +1993,16 @@ int enif_get_map_value(ErlNifEnv* env, Eterm key, Eterm *value) { - if (is_not_map(map)) { + const Eterm *ret; + if (!is_map(map)) { return 0; } - return erts_maps_get(key, map, value); + ret = erts_maps_get(key, map); + if (ret) { + *value = *ret; + return 1; + } + return 0; } int enif_make_map_update(ErlNifEnv* env, @@ -1971,7 +2012,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; } @@ -1987,7 +2028,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); @@ -2001,13 +2042,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_FIRST: offset = 0; break; + case ERL_NIF_MAP_ITERATOR_LAST: offset = flatmap_get_size(mp) - 1; break; default: goto error; } @@ -2016,14 +2057,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_FIRST: + 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_LAST: + 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; @@ -2033,48 +2097,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, @@ -2082,15 +2195,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..af806736fd 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,16 +202,28 @@ 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; typedef enum { - ERL_NIF_MAP_ITERATOR_HEAD = 1, - ERL_NIF_MAP_ITERATOR_TAIL = 2 + ERL_NIF_MAP_ITERATOR_FIRST = 1, + ERL_NIF_MAP_ITERATOR_LAST = 2, + + /* deprecated synonyms (undocumented in 17 and 18-rc) */ + ERL_NIF_MAP_ITERATOR_HEAD = ERL_NIF_MAP_ITERATOR_FIRST, + ERL_NIF_MAP_ITERATOR_TAIL = ERL_NIF_MAP_ITERATOR_LAST } ErlNifMapIteratorEntry; #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 630cefae93..e38a016958 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -156,6 +156,8 @@ 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, ERL_NIF_TERM* reason)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -305,6 +307,8 @@ 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) +# define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_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..6d827c6bda 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -705,7 +705,7 @@ erts_set_this_node(Eterm sysname, Uint creation) erts_this_node->sysname = sysname; erts_this_node->creation = creation; erts_this_node_sysname = erts_this_node_sysname_BUFFER; - erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname), + erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), "%T", sysname); (void) hash_put(&erts_node_table, (void *) erts_this_node); @@ -794,7 +794,7 @@ void erts_init_node_tables(void) erts_this_node->creation = 0; erts_this_node->dist_entry = erts_this_dist_entry; erts_this_node_sysname = erts_this_node_sysname_BUFFER; - erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname), + erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), "%T", erts_this_node->sysname); (void) hash_put(&erts_node_table, (void *) erts_this_node); @@ -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 d18760dc43..e0dfbd31b8 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-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 @@ -25,6 +25,7 @@ #include "sys.h" #include "big.h" #include "erl_map.h" +#include "erl_binary.h" #define PRINT_CHAR(CNT, FN, ARG, C) \ do { \ @@ -138,6 +139,25 @@ is_printable_string(Eterm list, Eterm* base) return 0; } +static int is_printable_ascii(byte* bytep, Uint bytesize, Uint bitoffs) +{ + if (!bitoffs) { + while (bytesize--) { + if (*bytep < ' ' || *bytep >= 127) + return 0; + bytep++; + } + } else { + while (bytesize--) { + byte octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + if (octet < ' ' || octet >= 127) + return 0; + bytep++; + } + } + return 1; +} + /* print a atom doing what quoting is necessary */ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) { @@ -227,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 */ @@ -283,13 +314,9 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, tl = CDR(cons); if (is_not_nil(tl)) { if (is_list(tl)) { - WSTACK_PUSH(s, tl); - WSTACK_PUSH(s, PRT_ONE_CONS); - WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH3(s, tl, PRT_ONE_CONS, PRT_COMMA); } else { - WSTACK_PUSH(s, tl); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_BAR); + WSTACK_PUSH3(s, tl, PRT_TERM, PRT_BAR); } } } @@ -299,9 +326,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, break; default: /* PRT_LAST_ARRAY_ELEMENT+1 and upwards */ obj = *popped.ptr; - WSTACK_PUSH(s, (UWord) (popped.ptr + 1)); - WSTACK_PUSH(s, val-1); - WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH3(s, (UWord) (popped.ptr + 1), val-1, PRT_COMMA); break; } break; @@ -431,8 +456,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, WSTACK_PUSH(s,PRT_CLOSE_TUPLE); ++nobj; if (i > 0) { - WSTACK_PUSH(s, (UWord) nobj); - WSTACK_PUSH(s, PRT_LAST_ARRAY_ELEMENT+i-1); + WSTACK_PUSH2(s, (UWord) nobj, PRT_LAST_ARRAY_ELEMENT+i-1); } break; case FLOAT_DEF: { @@ -446,13 +470,65 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_STRING(res, fn, arg, "#MatchState"); } else { - ProcBin* pb = (ProcBin *) binary_val(wobj); - if (pb->size == 1) - PRINT_STRING(res, fn, arg, "<<1 byte>>"); - else { + byte* bytep; + Uint bytesize = binary_size_rel(obj,obj_base); + Uint bitoffs; + Uint bitsize; + byte octet; + ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base); + + if (bitsize || !bytesize + || !is_printable_ascii(bytep, bytesize, bitoffs)) { + int is_first = 1; PRINT_STRING(res, fn, arg, "<<"); - PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) pb->size); - PRINT_STRING(res, fn, arg, " bytes>>"); + while (bytesize) { + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + ++bytep; + --bytesize; + } + if (bitsize) { + Uint bits = bitoffs + bitsize; + octet = bytep[0]; + if (bits < 8) + octet >>= 8 - bits; + else if (bits > 8) { + bits -= 8; /* bits in last byte */ + octet <<= bits; + octet |= bytep[1] >> (8 - bits); + } + octet &= (1 << bitsize) - 1; + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + PRINT_CHAR(res, fn, arg, ':'); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, bitsize); + } + PRINT_STRING(res, fn, arg, ">>"); + } + else { + PRINT_STRING(res, fn, arg, "<<\""); + while (bytesize) { + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + if (octet == '"') + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_CHAR(res, fn, arg, octet); + ++bytep; + --bytesize; + } + PRINT_STRING(res, fn, arg, "\">>"); } } break; @@ -489,37 +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_PUSH(s, vs[n]); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_ASSOC); - WSTACK_PUSH(s, ks[n]); - WSTACK_PUSH(s, PRT_TERM); - - while (n--) { - WSTACK_PUSH(s, PRT_COMMA); - WSTACK_PUSH(s, vs[n]); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_ASSOC); - WSTACK_PUSH(s, ks[n]); - WSTACK_PUSH(s, 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, '>'); @@ -528,17 +641,17 @@ 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) { int res; - ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm)); + ERTS_CT_ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm)); res = print_term(fn, arg, (Eterm)term, &precision, (Eterm*)term_base); if (res < 0) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ea63d20dfa..4940ffc4a0 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) @@ -152,7 +155,7 @@ extern BeamInstr beam_continue_exit[]; /* Eager check I/O not supported on OSE yet. */ int erts_eager_check_io = 0; #else -int erts_eager_check_io = 0; +int erts_eager_check_io = 1; #endif int erts_sched_compact_load; int erts_sched_balance_util = 0; @@ -457,13 +460,12 @@ do { \ static void exec_misc_ops(ErtsRunQueue *); static void print_function_from_pc(int to, void *to_arg, BeamInstr* x); -static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, - int yreg); +static int stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg); static void aux_work_timeout(void *unused); static void aux_work_timeout_early_init(int no_schedulers); static void aux_work_timeout_late_init(void); -static void setup_aux_work_timer(void); +static void setup_aux_work_timer(ErtsSchedulerData *esdp); static int execute_sys_tasks(Process *c_p, erts_aint32_t *statep, @@ -493,6 +495,8 @@ dbg_chk_aux_work_val(erts_aint32_t value) valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR; valid |= ERTS_SSI_AUX_WORK_DD; valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR; + valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS; + valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR; valid |= ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; #endif #if HAVE_ERTS_MSEG @@ -610,13 +614,11 @@ erts_pre_init_process(void) #endif } -#ifdef ERTS_SMP static void release_process(void *vproc) { - erts_smp_proc_dec_refc((Process *) vproc); + erts_proc_dec_refc((Process *) vproc); } -#endif /* initialize the scheduler */ void @@ -632,16 +634,18 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) erts_ptab_init_table(&erts_proc, ERTS_ALC_T_PROC_TABLE, -#ifdef ERTS_SMP release_process, -#else - NULL, -#endif (ErtsPTabElementCommon *) &erts_invalid_process.common, proc_tab_size, sizeof(Process), "process_table", - legacy_proc_tab); + legacy_proc_tab, +#ifdef ERTS_SMP + 1 +#else + 0 +#endif + ); last_reductions = 0; last_exact_reductions = 0; @@ -702,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; @@ -1023,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; @@ -1035,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); @@ -1067,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) @@ -1128,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; @@ -1144,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); @@ -1772,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 @@ -1869,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); } } @@ -1918,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, @@ -2033,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; } @@ -2093,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 @@ -2142,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; @@ -2153,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) { @@ -2185,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; @@ -2219,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 @@ -2275,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; @@ -2318,7 +2414,6 @@ erts_active_schedulers(void) ERTS_ATOMIC_FOREACH_RUNQ(rq, as -= abs(rq->waiting)); - ASSERT(as >= 0); return as; } @@ -2640,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) { @@ -2770,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) { @@ -2783,34 +2886,76 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_leader_update(esdp); } - if (aux_work) - flgs = erts_smp_atomic32_read_acqb(&ssi->flags); + if (aux_work) { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + 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 (!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 { + ErtsMonotonicTime timeout_time; + int do_timeout = 0; 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); + timeout_time = erts_check_next_timeout_time(esdp); + current_time = erts_get_monotonic_time(esdp); + do_timeout = (current_time >= timeout_time); + } else + timeout_time = ERTS_MONOTONIC_TIME_MAX; + if (do_timeout) { + if (!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_SCHEDULER_IS_DIRTY(esdp) ? 0 : + erts_get_monotonic_time(esdp); + do { + Sint64 timeout; + if (current_time >= timeout_time) + break; + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time + - current_time + - 1) + 1; + } else + timeout = -1; + res = erts_tse_twait(ssi->event, timeout); + current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : + 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 (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time) + erts_bump_timers(esdp->timer_wheel, current_time); } if (!(flgs & ERTS_SSI_FLG_WAITING)) { @@ -2843,7 +2988,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; @@ -2868,6 +3012,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) goto sys_aux_work; while (spincount-- > 0) { + ErtsMonotonicTime current_time; sys_poll_aux_work: @@ -2877,8 +3022,11 @@ 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); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + 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 @@ -2887,15 +3035,18 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { - if (!working) - sched_wall_time_change(esdp, working = 1); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!working) + sched_wall_time_change(esdp, working = 1); #ifdef ERTS_SMP - if (!thr_prgr_active) - erts_thr_progress_active(esdp, thr_prgr_active = 1); + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif + } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); #ifdef ERTS_SMP - if (aux_work && erts_thr_progress_update(esdp)) + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && aux_work && + erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); #endif } @@ -2993,8 +3144,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); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp); + if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) + erts_bump_timers(esdp->timer_wheel, current_time); + } #ifndef ERTS_SMP if (rq->len == 0 && !rq->misc.start) @@ -4885,9 +5039,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 = @@ -5200,6 +5356,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; @@ -5264,6 +5421,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; @@ -5276,6 +5434,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 @@ -5874,6 +6038,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 @@ -6586,7 +6751,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) int res; do { - res = erts_tse_wait(ssi->event); + res = erts_tse_twait(ssi->event, -1); } while (res == EINTR); } } @@ -6642,6 +6807,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) } } + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + (void) erts_get_monotonic_time(esdp); erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); @@ -6749,6 +6916,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; @@ -6756,7 +6924,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) & ERTS_RUNQ_FLGS_QMASK); aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work|qmask) { - if (!thr_prgr_active) { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); } @@ -6764,7 +6932,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); - if (aux_work && erts_thr_progress_update(esdp)) + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && aux_work && + erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); if (qmask) { erts_smp_runq_lock(esdp->run_queue); @@ -6773,30 +6942,77 @@ 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) { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + 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; + int do_timeout = 0; + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + timeout_time = erts_check_next_timeout_time(esdp); + current_time = erts_get_monotonic_time(esdp); + do_timeout = (current_time >= timeout_time); + } else + timeout_time = ERTS_MONOTONIC_TIME_MAX; + if (do_timeout) { + if (!thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } + } + 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); + } + 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_SCHEDULER_IS_DIRTY(esdp) ? 0 : + erts_get_monotonic_time(esdp); + do { + Sint64 timeout; + if (current_time >= timeout_time) + break; + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time + - current_time + - 1) + 1; + } else + timeout = -1; + res = erts_tse_twait(ssi->event, timeout); + current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : + erts_get_monotonic_time(esdp); + } while (res == EINTR); + } } + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + erts_thr_progress_finalize_wait(esdp); } - erts_thr_progress_finalize_wait(esdp); + + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time) + erts_bump_timers(esdp->timer_wheel, current_time); } flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING @@ -7615,6 +7831,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; @@ -7717,6 +7936,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 { @@ -7778,6 +7999,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 { @@ -7835,23 +8058,17 @@ erts_start_schedulers(void) Uint actual; Uint wanted = erts_no_schedulers; Uint wanted_no_schedulers = erts_no_schedulers; + char name[16]; ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER; opts.detached = 1; -#ifdef ETHR_HAVE_THREAD_NAMES - opts.name = malloc(80); - if (!opts.name) { - ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); - } -#endif + opts.name = name; #ifdef ERTS_SMP if (erts_runq_supervision_interval) { opts.suggested_stack_size = 16; -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(opts.name, "runq_supervisor"); -#endif + erts_snprintf(opts.name, 16, "runq_supervisor"); erts_atomic_init_nob(&runq_supervisor_sleeping, 0); if (0 != ethr_event_init(&runq_supervision_event)) erl_exit(1, "Failed to create run-queue supervision event\n"); @@ -7878,9 +8095,7 @@ erts_start_schedulers(void) ASSERT(actual == esdp->no - 1); -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(opts.name, "scheduler_%d", actual + 1); -#endif + erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1); #ifdef __OSE__ /* This should be done in the bind strategy */ @@ -7902,18 +8117,14 @@ erts_start_schedulers(void) int ix; for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(opts.name,"dirty_cpu_scheduler_%d", ix + 1); -#endif + erts_snprintf(opts.name, 16, "%d_dirty_cpu_scheduler", ix + 1); res = ethr_thr_create(&esdp->tid,sched_dirty_cpu_thread_func,(void*)esdp,&opts); if (res != 0) erl_exit(1, "Failed to create dirty cpu scheduler thread %d\n", ix); } for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(opts.name,"dirty_io_scheduler_%d", ix + 1); -#endif + erts_snprintf(opts.name, 16, "%d_dirty_io_scheduler", ix + 1); res = ethr_thr_create(&esdp->tid,sched_dirty_io_thread_func,(void*)esdp,&opts); if (res != 0) erl_exit(1, "Failed to create dirty io scheduler thread %d\n", ix); @@ -7924,9 +8135,7 @@ erts_start_schedulers(void) ERTS_THR_MEMORY_BARRIER; -#ifdef ETHR_HAVE_THREAD_NAMES - sprintf(opts.name, "aux"); -#endif + erts_snprintf(opts.name, 16, "aux"); #ifdef __OSE__ opts.coreNo = 0; @@ -7952,9 +8161,6 @@ erts_start_schedulers(void) erts_send_error_to_logger_nogl(dsbufp); } -#ifdef ETHR_HAVE_THREAD_NAMES - free(opts.name); -#endif } #endif /* ERTS_SMP */ @@ -8897,7 +9103,6 @@ Process *schedule(Process *p, int calls) { Process *proxy_p = NULL; ErtsRunQueue *rq; - erts_aint_t dt; ErtsSchedulerData *esdp; int context_reds; int fcalls; @@ -8997,7 +9202,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); @@ -9014,12 +9219,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 @@ -9027,11 +9229,15 @@ Process *schedule(Process *p, int calls) ERTS_SMP_CHK_NO_PROC_LOCKS; - dt = erts_do_time_read_and_reset(); - if (dt) { - erts_smp_runq_unlock(rq); - erts_bump_timer(dt); - erts_smp_runq_lock(rq); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (esdp->check_time_reds >= ERTS_CHECK_TIME_REDS) + (void) erts_get_monotonic_time(esdp); + + if (esdp->last_monotonic_time >= erts_next_timeout_time(esdp->next_tmo_ref)) { + erts_smp_runq_unlock(rq); + erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time); + erts_smp_runq_lock(rq); + } } BM_STOP_TIMER(system); @@ -9177,6 +9383,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. */ @@ -9189,8 +9396,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); @@ -9329,13 +9538,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; @@ -9478,6 +9682,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 (!(state & ERTS_PSFLG_EXITING) && 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; } } @@ -9530,15 +9748,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; @@ -10394,6 +10604,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); } @@ -10436,7 +10648,7 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state) init_arg.run_queue = rq; init_arg.state = state; - ASSERT(((char *) p) == ((char *) &p->common)); + ERTS_CT_ASSERT(offsetof(Process,common) == 0); if (!erts_ptab_new_element(&erts_proc, &p->common, @@ -10446,6 +10658,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(); @@ -10495,6 +10709,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; @@ -10527,6 +10742,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; @@ -10539,9 +10757,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. @@ -10582,7 +10800,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; @@ -10605,11 +10823,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; @@ -10640,7 +10854,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; @@ -10798,11 +11013,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; @@ -10823,14 +11034,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; @@ -10851,6 +11063,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 @@ -10915,7 +11129,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); @@ -11079,7 +11294,6 @@ set_proc_exiting(Process *p, */ p->freason = EXTAG_EXIT; KILL_CATCHES(p); - cancel_timer(p); p->i = (BeamInstr *) beam_exit; if (enqueue) @@ -11224,11 +11438,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; @@ -11244,11 +11454,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); } } @@ -11501,7 +11707,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)); @@ -11564,7 +11771,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)) { @@ -11623,6 +11831,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, @@ -11769,6 +11983,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)) { @@ -11781,6 +11996,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 @@ -11820,20 +12038,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); } @@ -11858,6 +12076,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; @@ -11951,6 +12190,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! */ @@ -11969,29 +12210,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) @@ -12082,64 +12317,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. */ @@ -12155,7 +12332,7 @@ erts_stack_dump(int to, void *to_arg, Process *p) } erts_program_counter_info(to, to_arg, p); for (sp = p->stop; sp < STACK_START(p); sp++) { - yreg = stack_element_dump(to, to_arg, p, sp, yreg); + yreg = stack_element_dump(to, to_arg, sp, yreg); } } @@ -12212,7 +12389,7 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x) } static int -stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) +stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg) { Eterm x = *sp; @@ -12241,6 +12418,220 @@ stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) } /* + * Print scheduler information + */ +void +erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { + int i; + erts_aint32_t flg; + Process *p; + + erts_print(to, to_arg, "=scheduler:%u\n", esdp->no); + +#ifdef ERTS_SMP + flg = erts_smp_atomic32_read_dirty(&esdp->ssi->flags); + erts_print(to, to_arg, "Scheduler Sleep Info Flags: "); + for (i = 0; i < ERTS_SSI_FLGS_MAX && flg; i++) { + erts_aint32_t chk = (1 << i); + if (flg & chk) { + switch (chk) { + case ERTS_SSI_FLG_SLEEPING: + erts_print(to, to_arg, "SLEEPING"); break; + case ERTS_SSI_FLG_POLL_SLEEPING: + erts_print(to, to_arg, "POLL_SLEEPING"); break; + case ERTS_SSI_FLG_TSE_SLEEPING: + erts_print(to, to_arg, "TSE_SLEEPING"); break; + case ERTS_SSI_FLG_WAITING: + erts_print(to, to_arg, "WAITING"); break; + case ERTS_SSI_FLG_SUSPENDED: + erts_print(to, to_arg, "SUSPENDED"); break; + default: + erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; + } + if (flg > chk) + erts_print(to, to_arg, " | "); + flg -= chk; + } + } + erts_print(to, to_arg, "\n"); +#endif + + flg = erts_atomic32_read_dirty(&esdp->ssi->aux_work); + erts_print(to, to_arg, "Scheduler Sleep Info Aux Work: "); + for (i = 0; i < ERTS_SSI_AUX_WORK_MAX && flg; i++) { + erts_aint32_t chk = (1 << i); + if (flg & chk) { + switch (chk) { + case ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP: + erts_print(to, to_arg, "DELAYED_AW_WAKEUP"); break; + case ERTS_SSI_AUX_WORK_DD: + erts_print(to, to_arg, "DELAYED_DEALLOC"); break; + case ERTS_SSI_AUX_WORK_DD_THR_PRGR: + erts_print(to, to_arg, "DELAYED_DEALLOC_THR_PRGR"); break; + case ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC: + erts_print(to, to_arg, "FIX_ALLOC_DEALLOC"); break; + case ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM: + 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: + erts_print(to, to_arg, "ASYNC_READY_CLEAN"); break; + case ERTS_SSI_AUX_WORK_MISC_THR_PRGR: + erts_print(to, to_arg, "MISC_THR_PRGR"); break; + case ERTS_SSI_AUX_WORK_MISC: + erts_print(to, to_arg, "MISC"); break; + case ERTS_SSI_AUX_WORK_CHECK_CHILDREN: + erts_print(to, to_arg, "CHECK_CHILDREN"); break; + case ERTS_SSI_AUX_WORK_SET_TMO: + erts_print(to, to_arg, "SET_TMO"); break; + case ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK: + erts_print(to, to_arg, "MSEG_CACHE_CHECK"); break; + case ERTS_SSI_AUX_WORK_REAP_PORTS: + erts_print(to, to_arg, "REAP_PORTS"); break; + default: + erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; + } + if (flg > chk) + erts_print(to, to_arg, " | "); + flg -= chk; + } + } + erts_print(to, to_arg, "\n"); + + erts_print(to, to_arg, "Current Port: "); + if (esdp->current_port) + erts_print(to, to_arg, "%T", esdp->current_port->common.id); + erts_print(to, to_arg, "\n"); + + for (i = 0; i < ERTS_NO_PROC_PRIO_LEVELS; i++) { + erts_print(to, to_arg, "Run Queue "); + switch (i) { + case PRIORITY_MAX: + erts_print(to, to_arg, "Max "); + break; + case PRIORITY_HIGH: + erts_print(to, to_arg, "High "); + break; + case PRIORITY_NORMAL: + erts_print(to, to_arg, "Normal "); + break; + case PRIORITY_LOW: + erts_print(to, to_arg, "Low "); + break; + default: + erts_print(to, to_arg, "Unknown "); + break; + } + erts_print(to, to_arg, "Length: %d\n", + erts_smp_atomic32_read_dirty(&esdp->run_queue->procs.prio_info[i].len)); + } + erts_print(to, to_arg, "Run Queue Port Length: %d\n", + erts_smp_atomic32_read_dirty(&esdp->run_queue->ports.info.len)); + + flg = erts_smp_atomic32_read_dirty(&esdp->run_queue->flags); + erts_print(to, to_arg, "Run Queue Flags: "); + for (i = 0; i < ERTS_RUNQ_FLG_MAX && flg; i++) { + erts_aint32_t chk = (1 << i); + if (flg & chk) { + switch (chk) { + case (1 << PRIORITY_MAX): + erts_print(to, to_arg, "NONEMPTY_MAX"); break; + case (1 << PRIORITY_HIGH): + erts_print(to, to_arg, "NONEMPTY_HIGH"); break; + case (1 << PRIORITY_NORMAL): + erts_print(to, to_arg, "NONEMPTY_NORMAL"); break; + case (1 << PRIORITY_LOW): + erts_print(to, to_arg, "NONEMPTY_LOW"); break; + case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)): + erts_print(to, to_arg, "EMIGRATE_MAX"); break; + case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)): + erts_print(to, to_arg, "EMIGRATE_HIGH"); break; + case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)): + erts_print(to, to_arg, "EMIGRATE_NORMAL"); break; + case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)): + erts_print(to, to_arg, "EMIGRATE_LOW"); break; + case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)): + erts_print(to, to_arg, "IMMIGRATE_MAX"); break; + case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)): + erts_print(to, to_arg, "IMMIGRATE_HIGH"); break; + case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)): + erts_print(to, to_arg, "IMMIGRATE_NORMAL"); break; + case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)): + erts_print(to, to_arg, "IMMIGRATE_LOW"); break; + case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_EVACUATE_SHFT)): + erts_print(to, to_arg, "EVACUATE_MAX"); break; + case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_EVACUATE_SHFT)): + erts_print(to, to_arg, "EVACUATE_HIGH"); break; + case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_EVACUATE_SHFT)): + erts_print(to, to_arg, "EVACUATE_NORMAL"); break; + case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_EVACUATE_SHFT)): + erts_print(to, to_arg, "EVACUATE_LOW"); break; + case ERTS_RUNQ_FLG_OUT_OF_WORK: + erts_print(to, to_arg, "OUT_OF_WORK"); break; + case ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK: + erts_print(to, to_arg, "HALFTIME_OUT_OF_WORK"); break; + case ERTS_RUNQ_FLG_SUSPENDED: + erts_print(to, to_arg, "SUSPENDED"); break; + case ERTS_RUNQ_FLG_CHK_CPU_BIND: + erts_print(to, to_arg, "CHK_CPU_BIND"); break; + case ERTS_RUNQ_FLG_INACTIVE: + erts_print(to, to_arg, "INACTIVE"); break; + case ERTS_RUNQ_FLG_NONEMPTY: + erts_print(to, to_arg, "NONEMPTY"); break; + case ERTS_RUNQ_FLG_PROTECTED: + erts_print(to, to_arg, "PROTECTED"); break; + default: + erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; + } + if (flg > chk) + erts_print(to, to_arg, " | "); + flg -= chk; + } + } + erts_print(to, to_arg, "\n"); + + /* This *MUST* to be the last information in scheduler block */ + p = esdp->current_process; + erts_print(to, to_arg, "Current Process: "); + if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) { + flg = erts_smp_atomic32_read_dirty(&p->state); + erts_print(to, to_arg, "%T\n", p->common.id); + + erts_print(to, to_arg, "Current Process State: "); + erts_dump_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Internal State: "); + erts_dump_extended_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); + print_function_from_pc(to, to_arg, p->i); + erts_print(to, to_arg, ")\n"); + erts_print(to, to_arg, "Current Process CP: %p (", p->cp); + print_function_from_pc(to, to_arg, p->cp); + erts_print(to, to_arg, ")\n"); + + /* Getting this stacktrace can segfault if we are very very + unlucky if called while a process is being garbage collected. + Therefore we only call this on other schedulers if we either + have protection against segfaults, or we know that the process + is not garbage collecting. It *should* always be safe to call + on a process owned by us, even if it is currently being garbage + collected. + */ + erts_print(to, to_arg, "Current Process Limited Stack Trace:\n"); + erts_limited_stack_trace(to, to_arg, p); + } else + erts_print(to, to_arg, "\n"); + +} + +/* * A nice system halt closing all open port goes as follows: * 1) This function schedules the aux work ERTS_SSI_AUX_WORK_REAP_PORTS * on all schedulers, then schedules itself out. diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index f50b217d4a..b1c30e7652 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -52,12 +52,13 @@ 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" #include "erl_mseg.h" #include "erl_async.h" +#include "erl_gc.h" #ifdef HIPE #include "hipe_process.h" @@ -169,6 +170,8 @@ extern int erts_sched_thread_suggested_stack_size; #define ERTS_RUNQ_FLG_PROTECTED \ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 6)) +#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 7) + #define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ (ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ | ERTS_RUNQ_FLGS_IMMIGRATE_QMASK \ @@ -251,6 +254,8 @@ typedef enum { #define ERTS_SSI_FLG_WAITING (((erts_aint32_t) 1) << 3) #define ERTS_SSI_FLG_SUSPENDED (((erts_aint32_t) 1) << 4) +#define ERTS_SSI_FLGS_MAX 5 + #define ERTS_SSI_FLGS_SLEEP_TYPE \ (ERTS_SSI_FLG_TSE_SLEEPING|ERTS_SSI_FLG_POLL_SLEEPING) @@ -273,14 +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_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; @@ -341,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 @@ -456,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 { @@ -483,11 +494,6 @@ typedef struct { } ErtsSchedWallTime; typedef struct { - Uint64 reclaimed; - Uint64 garbage_cols; -} ErtsGCInfo; - -typedef struct { int sched; erts_aint32_t aux_work; } ErtsDelayedAuxWorkWakeupJob; @@ -514,6 +520,9 @@ typedef struct { } dd; struct { ErtsThrPrgrVal thr_prgr; + } cncld_tmrs; + struct { + ErtsThrPrgrVal thr_prgr; UWord size; ErtsThrPrgrLaterOp *first; ErtsThrPrgrLaterOp *last; @@ -562,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 */ @@ -588,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; @@ -905,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 */ @@ -919,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; @@ -934,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. */ @@ -1079,6 +1101,9 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19) #define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20) #define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22) +#else +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18) #endif #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ @@ -1093,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} @@ -1120,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. @@ -1242,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 \ @@ -1277,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) @@ -1569,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 @@ -1603,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 */ @@ -1614,7 +1646,11 @@ void erts_cleanup_empty_process(Process* p); void erts_debug_verify_clean_empty_process(Process* p); #endif void erts_stack_dump(int to, void *to_arg, Process *); +void erts_limited_stack_trace(int to, void *to_arg, Process *); void erts_program_counter_info(int to, void *to_arg, Process *); +void erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp); +void erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg); +void erts_dump_process_state(int to, void *to_arg, erts_aint32_t psflg); Eterm erts_get_process_priority(Process *p); Eterm erts_set_process_priority(Process *p, Eterm prio); @@ -2219,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 af20b26b15..00761f2d0e 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -82,6 +82,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); static void pd_hash_erase_all(Process *p); static Eterm pd_hash_get_keys(Process *p, Eterm value); +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd); static Eterm pd_hash_get_all(Process *p, ProcDict *pd); static Eterm pd_hash_put(Process *p, Eterm id, Eterm value); @@ -275,6 +276,16 @@ BIF_RETTYPE get_1(BIF_ALIST_1) BIF_RET(ret); } +BIF_RETTYPE get_keys_0(BIF_ALIST_0) +{ + Eterm ret; + + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_all_keys(BIF_P,BIF_P->dictionary); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + BIF_RETTYPE get_keys_1(BIF_ALIST_1) { Eterm ret; @@ -412,6 +423,47 @@ Eterm erts_pd_hash_get(Process *p, Eterm id) return am_undefined; } +#define PD_GET_TKEY(Dst,Src) \ +do { \ + ASSERT(is_tuple((Src))); \ + ASSERT(arityval(*((Eterm*)tuple_val((Src)))) == 2); \ + (Dst) = ((Eterm*)tuple_val((Src)))[1]; \ +} while(0) + +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd) { + Eterm* hp; + Eterm res = NIL; + Eterm tmp, tmp2; + unsigned int i; + unsigned int num; + + if (pd == NULL) { + return res; + } + + num = HASH_RANGE(pd); + hp = HAlloc(p, pd->numElements * 2); + + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + PD_GET_TKEY(tmp,tmp); + res = CONS(hp, tmp, res); + hp += 2; + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + PD_GET_TKEY(tmp2,tmp2); + res = CONS(hp, tmp2, res); + hp += 2; + tmp = TCDR(tmp); + } + } + } + return res; +} +#undef PD_GET_TKEY + static Eterm pd_hash_get_keys(Process *p, Eterm value) { Eterm *hp; diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 2f3cf23b00..36bb6b2f0e 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -43,8 +43,9 @@ static void dump_process_info(int to, void *to_arg, Process *p); static void dump_element(int to, void *to_arg, Eterm x); static void dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep); static void dump_element_nl(int to, void *to_arg, Eterm x); -static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, +static int stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg); +static void stack_trace_dump(int to, void *to_arg, Eterm* sp); static void print_function_from_pc(int to, void *to_arg, BeamInstr* x); static void heap_dump(int to, void *to_arg, Eterm x); static void dump_binaries(int to, void *to_arg, Binary* root); @@ -148,7 +149,7 @@ dump_process_info(int to, void *to_arg, Process *p) if ((ERTS_TRACE_FLAGS(p) & F_SENSITIVE) == 0) { erts_print(to, to_arg, "=proc_stack:%T\n", p->common.id); for (sp = p->stop; sp < STACK_START(p); sp++) { - yreg = stack_element_dump(to, to_arg, p, sp, yreg); + yreg = stack_element_dump(to, to_arg, sp, yreg); } erts_print(to, to_arg, "=proc_heap:%T\n", p->common.id); @@ -243,9 +244,65 @@ dump_element_nl(int to, void *to_arg, Eterm x) erts_putc(to, to_arg, '\n'); } +static void +stack_trace_dump(int to, void *to_arg, Eterm *sp) { + Eterm x = *sp; + if (is_CP(x)) { + erts_print(to, to_arg, "%p:", sp); + erts_print(to, to_arg, "SReturn addr 0x%X (", cp_val(x)); + print_function_from_pc(to, to_arg, cp_val(x)); + erts_print(to, to_arg, ")\n"); + } +} + +void +erts_limited_stack_trace(int to, void *to_arg, Process *p) +{ + Eterm* sp; + + + if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) { + return; + } + + if (STACK_START(p) < STACK_TOP(p)) { + return; + } + + if ((STACK_START(p) - STACK_TOP(p)) < 512) { + if (erts_sys_is_area_readable((char*)STACK_TOP(p), + (char*)STACK_START(p))) + for (sp = STACK_TOP(p); sp < STACK_START(p); sp++) + stack_trace_dump(to, to_arg, sp); + else + erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n", + STACK_TOP(p), STACK_START(p)); + } else { + sp = STACK_TOP(p); + if (erts_sys_is_area_readable((char*)STACK_TOP(p), + (char*)(STACK_TOP(p) + 25))) + for (; sp < (STACK_TOP(p) + 256); sp++) + stack_trace_dump(to, to_arg, sp); + else + erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n", + STACK_TOP(p), STACK_TOP(p) + 256); + + erts_print(to, to_arg, "%p: skipping %d frames\n", + sp, STACK_START(p) - STACK_TOP(p) - 512); + + if (erts_sys_is_area_readable((char*)(STACK_START(p) - 256), + (char*)STACK_START(p))) + for (sp = STACK_START(p) - 256; sp < STACK_START(p); sp++) + stack_trace_dump(to, to_arg, sp); + else + erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n", + STACK_START(p) - 256, STACK_START(p)); + } + +} static int -stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) +stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg) { Eterm x = *sp; @@ -508,3 +565,114 @@ dump_externally(int to, void *to_arg, Eterm term) erts_print(to, to_arg, "%02X", *s++); } } + +void erts_dump_process_state(int to, void *to_arg, erts_aint32_t psflg) { + if (psflg & ERTS_PSFLG_FREE) + erts_print(to, to_arg, "Non Existing\n"); /* Should never happen */ + else if (psflg & ERTS_PSFLG_EXITING) + erts_print(to, to_arg, "Exiting\n"); + else if (psflg & ERTS_PSFLG_GC) { + erts_print(to, to_arg, "Garbing\n"); + } + else if (psflg & ERTS_PSFLG_SUSPENDED) + erts_print(to, to_arg, "Suspended\n"); + else if (psflg & ERTS_PSFLG_RUNNING) { + erts_print(to, to_arg, "Running\n"); + } + else if (psflg & ERTS_PSFLG_ACTIVE) + erts_print(to, to_arg, "Scheduled\n"); + else + erts_print(to, to_arg, "Waiting\n"); +} + +void +erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { + + int i; + + switch (ERTS_PSFLGS_GET_ACT_PRIO(psflg)) { + case PRIORITY_MAX: erts_print(to, to_arg, "ACT_PRIO_MAX | "); break; + case PRIORITY_HIGH: erts_print(to, to_arg, "ACT_PRIO_HIGH | "); break; + case PRIORITY_NORMAL: erts_print(to, to_arg, "ACT_PRIO_NORMAL | "); break; + case PRIORITY_LOW: erts_print(to, to_arg, "ACT_PRIO_LOW | "); break; + } + switch (ERTS_PSFLGS_GET_USR_PRIO(psflg)) { + case PRIORITY_MAX: erts_print(to, to_arg, "USR_PRIO_MAX | "); break; + case PRIORITY_HIGH: erts_print(to, to_arg, "USR_PRIO_HIGH | "); break; + case PRIORITY_NORMAL: erts_print(to, to_arg, "USR_PRIO_NORMAL | "); break; + case PRIORITY_LOW: erts_print(to, to_arg, "USR_PRIO_LOW | "); break; + } + switch (ERTS_PSFLGS_GET_PRQ_PRIO(psflg)) { + case PRIORITY_MAX: erts_print(to, to_arg, "PRQ_PRIO_MAX"); break; + case PRIORITY_HIGH: erts_print(to, to_arg, "PRQ_PRIO_HIGH"); break; + case PRIORITY_NORMAL: erts_print(to, to_arg, "PRQ_PRIO_NORMAL"); break; + case PRIORITY_LOW: erts_print(to, to_arg, "PRQ_PRIO_LOW"); break; + } + + psflg &= ~(ERTS_PSFLGS_ACT_PRIO_MASK | + ERTS_PSFLGS_USR_PRIO_MASK | + ERTS_PSFLGS_PRQ_PRIO_MASK); + + if (psflg) + erts_print(to, to_arg, " | "); + + for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) { + erts_aint32_t chk = (1 << i); + if (psflg & chk) { + switch (chk) { + case ERTS_PSFLG_IN_PRQ_MAX: + erts_print(to, to_arg, "IN_PRQ_MAX"); break; + case ERTS_PSFLG_IN_PRQ_HIGH: + erts_print(to, to_arg, "IN_PRQ_HIGH"); break; + case ERTS_PSFLG_IN_PRQ_NORMAL: + erts_print(to, to_arg, "IN_PRQ_NORMAL"); break; + case ERTS_PSFLG_IN_PRQ_LOW: + erts_print(to, to_arg, "IN_PRQ_LOW"); break; + case ERTS_PSFLG_FREE: + erts_print(to, to_arg, "FREE"); break; + case ERTS_PSFLG_EXITING: + erts_print(to, to_arg, "EXITING"); break; + case ERTS_PSFLG_PENDING_EXIT: + erts_print(to, to_arg, "PENDING_EXIT"); break; + case ERTS_PSFLG_ACTIVE: + erts_print(to, to_arg, "ACTIVE"); break; + case ERTS_PSFLG_IN_RUNQ: + erts_print(to, to_arg, "IN_RUNQ"); break; + case ERTS_PSFLG_RUNNING: + erts_print(to, to_arg, "RUNNING"); break; + case ERTS_PSFLG_SUSPENDED: + erts_print(to, to_arg, "SUSPENDED"); break; + case ERTS_PSFLG_GC: + erts_print(to, to_arg, "GC"); break; + case ERTS_PSFLG_BOUND: + erts_print(to, to_arg, "BOUND"); break; + case ERTS_PSFLG_TRAP_EXIT: + erts_print(to, to_arg, "TRAP_EXIT"); break; + case ERTS_PSFLG_ACTIVE_SYS: + erts_print(to, to_arg, "ACTIVE_SYS"); break; + case ERTS_PSFLG_RUNNING_SYS: + erts_print(to, to_arg, "RUNNING_SYS"); break; + case ERTS_PSFLG_PROXY: + erts_print(to, to_arg, "PROXY"); break; + case ERTS_PSFLG_DELAYED_SYS: + erts_print(to, to_arg, "DELAYED_SYS"); break; +#ifdef ERTS_DIRTY_SCHEDULERS + case ERTS_PSFLG_DIRTY_CPU_PROC: + erts_print(to, to_arg, "DIRTY_CPU_PROC"); break; + case ERTS_PSFLG_DIRTY_IO_PROC: + erts_print(to, to_arg, "DIRTY_IO_PROC"); break; + case ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q: + erts_print(to, to_arg, "DIRTY_CPU_PROC_IN_Q"); break; + case ERTS_PSFLG_DIRTY_IO_PROC_IN_Q: + erts_print(to, to_arg, "DIRTY_IO_PROC_IN_Q"); break; +#endif + default: + erts_print(to, to_arg, "UNKNOWN(%d)", chk); break; + } + if (psflg > chk) + erts_print(to, to_arg, " | "); + psflg -= chk; + } + } + erts_print(to, to_arg, "\n"); +} 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 664c479eb6..78e0964e8b 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -1335,25 +1335,10 @@ erts_thr_progress_block(void) thr_progress_block(tmp_thr_prgr_data(NULL), 1); } -void -erts_thr_progress_fatal_error_block(SWord timeout, - ErtsThrPrgrData *tmp_tpd_bufp) +int +erts_thr_progress_fatal_error_block(ErtsThrPrgrData *tmp_tpd_bufp) { ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); - erts_aint32_t bc; - SWord time_left = timeout; - SysTimeval to; - - /* - * 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 (!erts_disable_tolerant_timeofday) { - erts_get_timeval(&to); - to.tv_sec += timeout / 1000; - to.tv_sec += timeout % 1000; - } if (!tpd) { /* @@ -1366,9 +1351,25 @@ erts_thr_progress_fatal_error_block(SWord timeout, init_tmp_thr_prgr_data(tpd); } - bc = thr_progress_block(tpd, 0); - if (bc == 0) - return; /* Succefully blocked all managed threads */ + /* Returns number of threads that have not yes been blocked */ + return thr_progress_block(tpd, 0); +} + +void +erts_thr_progress_fatal_error_wait(SWord timeout) { + erts_aint32_t bc; + SWord time_left = timeout; + ErtsMonotonicTime timeout_time; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + + /* + * Counting poll intervals may give us a too long timeout + * 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... + */ + 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) @@ -1378,14 +1379,8 @@ erts_thr_progress_fatal_error_block(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_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index 03ddbd467c..cf11c4e114 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -83,8 +83,8 @@ typedef struct { ErtsThrPrgrLeaderState leader_state; } ErtsThrPrgrData; -void erts_thr_progress_fatal_error_block(SWord timeout, - ErtsThrPrgrData *tmp_tpd_bufp); +int erts_thr_progress_fatal_error_block(ErtsThrPrgrData *tmp_tpd_bufp); +void erts_thr_progress_fatal_error_wait(SWord timeout); #endif /* ERTS_SMP */ diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 7214f3ea33..dc20ac207f 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -476,6 +476,7 @@ ERTS_GLB_INLINE void erts_thr_detach(erts_tid_t tid); ERTS_GLB_INLINE void erts_thr_exit(void *res); ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void)); ERTS_GLB_INLINE erts_tid_t erts_thr_self(void); +ERTS_GLB_INLINE int erts_thr_getname(erts_tid_t tid, char *buf, size_t len); ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y); ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt); @@ -651,16 +652,24 @@ 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); ERTS_GLB_INLINE void erts_thr_yield(void); + #ifdef ETHR_HAVE_ETHR_SIG_FUNCS #define ERTS_THR_HAVE_SIG_FUNCS 1 ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set, sigset_t *oset); ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); + +#ifdef USE_THREADS +ERTS_GLB_INLINE void erts_thr_kill(erts_tid_t tid, int sig); +#endif + #endif /* #ifdef HAVE_ETHR_SIG_FUNCS */ #ifdef USE_THREADS @@ -2129,6 +2138,16 @@ erts_thr_self(void) #endif } +ERTS_GLB_INLINE int +erts_thr_getname(erts_tid_t tid, char *buf, size_t len) +{ +#ifdef USE_THREADS + return ethr_getname(tid, buf, len); +#else + return -1; +#endif +} + ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y) @@ -3473,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 @@ -3517,6 +3557,15 @@ ERTS_GLB_INLINE void erts_thr_yield(void) #ifdef ETHR_HAVE_ETHR_SIG_FUNCS ERTS_GLB_INLINE void +erts_thr_kill(erts_tid_t tid, int sig) { +#ifdef USE_THREADS + int res = ethr_kill((ethr_tid)tid, sig); + if (res) + erts_thr_fatal_error(res, "killing thread"); +#endif +} + +ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set, sigset_t *oset) { #ifdef USE_THREADS diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 4bbdcaa3e3..4560cd23af 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -20,94 +20,49 @@ #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)) +#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) # ifndef HAVE_ERTS_NOW_CPU # define HAVE_ERTS_NOW_CPU # ifdef HAVE_GETHRVTIME @@ -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 ea5c850a30..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 } } @@ -2225,7 +2213,7 @@ trace_gc(Process *p, Eterm what) Eterm* limit; #endif - ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm)); + ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm)); UseTmpHeap(LOCAL_HEAP_SIZE,p); @@ -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 @@ -3492,16 +3456,13 @@ init_sys_msg_dispatcher(void) thr_opts.coreNo = 0; #endif thr_opts.detached = 1; + thr_opts.name = "sys_msg_dispatcher"; init_smq_element_alloc(); sys_message_queue = NULL; sys_message_queue_end = NULL; erts_smp_cnd_init(&smq_cnd); erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); -#ifdef ETHR_HAVE_THREAD_NAMES - thr_opts.name = "sys_msg_dispatcher"; -#endif - erts_smp_thr_create(&sys_msg_dispatcher_tid, sys_msg_dispatcher_func, NULL, 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 6687b044ee..3a9fb1e07b 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -20,8 +20,6 @@ #ifndef __ERL_VM_H__ #define __ERL_VM_H__ -/* #define ERTS_OPCODE_COUNTER_SUPPORT */ - /* FORCE_HEAP_FRAGS: * Debug provocation to make HAlloc always create heap fragments (if allowed) * even if there is room on heap. @@ -119,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 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 45d1f7514e..fe48298155 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -36,7 +36,9 @@ #include "erl_process.h" #include "error.h" #include "external.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_binary.h" @@ -498,15 +500,37 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint return ep; } -Uint erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp) +int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, + Uint* szp) { - Uint sz = 0; + Uint sz; + if (encode_size_struct_int(NULL, acmp, term, flags, NULL, &sz)) { + return -1; + } else { #ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) #endif - sz++ /* VERSION_MAGIC */; - sz += encode_size_struct2(acmp, term, flags); - return sz; + sz++ /* VERSION_MAGIC */; + + *szp += sz; + return 0; + } +} + +int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp) +{ + Uint sz; + if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) { + return -1; + } else { +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE)) +#endif + sz++ /* VERSION_MAGIC */; + + *szp += sz; + return 0; + } } Uint erts_encode_ext_size(Eterm term) @@ -527,19 +551,16 @@ Uint erts_encode_ext_size_ets(Eterm term) } -void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) +int erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp, + TTBEncodeContext* ctx, Sint* reds) { - byte *ep = *ext; -#ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) -#endif - *ep++ = VERSION_MAGIC; - ep = enc_term(acmp, term, ep, flags, NULL); - if (!ep) - erl_exit(ERTS_ABORT_EXIT, - "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", - __FILE__, __LINE__); - *ext = ep; + if (!ctx || !ctx->wstack.wstart) { + #ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + #endif + *(*ext)++ = VERSION_MAGIC; + } + return enc_term_int(ctx, acmp, term, *ext, flags, NULL, reds, ext); } void erts_encode_ext(Eterm term, byte **ext) @@ -1161,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 { @@ -1487,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: @@ -1740,54 +1763,14 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { return erts_term_to_binary_simple(p, Term, size, level, flags); } -/* Define for testing */ -/* #define EXTREME_TTB_TRAPPING 1 */ +/* Define EXTREME_TTB_TRAPPING for testing in dist.h */ #ifndef EXTREME_TTB_TRAPPING -#define TERM_TO_BINARY_LOOP_FACTOR 32 #define TERM_TO_BINARY_COMPRESS_CHUNK (1 << 18) #else -#define TERM_TO_BINARY_LOOP_FACTOR 1 #define TERM_TO_BINARY_COMPRESS_CHUNK 10 #endif - - -typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; -typedef struct TTBSizeContext_ { - Uint flags; - int level; - Uint result; - Eterm obj; - ErtsEStack estack; -} TTBSizeContext; - -typedef struct TTBEncodeContext_ { - Uint flags; - int level; - byte* ep; - Eterm obj; - ErtsWStack wstack; - Binary *result_bin; -} TTBEncodeContext; - -typedef struct { - Uint real_size; - Uint dest_len; - byte *dbytes; - Binary *result_bin; - Binary *destination_bin; - z_stream stream; -} TTBCompressContext; - -typedef struct { - int alive; - TTBState state; - union { - TTBSizeContext sc; - TTBEncodeContext ec; - TTBCompressContext cc; - } s; -} TTBContext; +#define TERM_TO_BINARY_MEMCPY_FACTOR 8 static void ttb_context_destructor(Binary *context_bin) { @@ -1796,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); @@ -1864,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 { @@ -1899,8 +1882,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } result_bin = erts_bin_nrml_alloc(size); - result_bin->flags = 0; - result_bin->orig_size = size; erts_refc_init(&result_bin->refc, 0); result_bin->orig_bytes[0] = VERSION_MAGIC; /* Next state immediately, no need to export context */ @@ -1925,7 +1906,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } real_size = endp - bytes; result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size); - result_bin->orig_size = real_size; level = context->s.ec.level; BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); if (level == 0 || real_size < 6) { /* We are done */ @@ -1962,8 +1942,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla context->s.cc.result_bin = result_bin; result_bin = erts_bin_nrml_alloc(real_size); - result_bin->flags = 0; - result_bin->orig_size = real_size; erts_refc_init(&result_bin->refc, 0); result_bin->orig_bytes[0] = VERSION_MAGIC; @@ -2005,7 +1983,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla erl_zlib_deflate_finish(&(context->s.cc.stream)); result_bin = erts_bin_realloc(context->s.cc.destination_bin, context->s.cc.dest_len+6); - result_bin->orig_size = context->s.cc.dest_len+6; context->s.cc.destination_bin = NULL; pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); pb->thing_word = HEADER_PROC_BIN; @@ -2327,8 +2304,10 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_TERM ((Eterm) 0) #define ENC_ONE_CONS ((Eterm) 1) #define ENC_PATCH_FUN_SIZE ((Eterm) 2) -#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) - +#define ENC_BIN_COPY ((Eterm) 3) +#define ENC_MAP_PAIR ((Eterm) 4) +#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, @@ -2364,6 +2343,9 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, WSTACK_RESTORE(s, &ctx->wstack); ep = ctx->ep; obj = ctx->obj; + if (is_non_value(obj)) { + goto outer_loop; + } } } @@ -2387,8 +2369,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - WSTACK_PUSH(s, tl); + WSTACK_PUSH2(s, (is_list(tl) ? ENC_ONE_CONS : ENC_TERM), + tl); } break; case ENC_PATCH_FUN_SIZE: @@ -2401,6 +2383,46 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, put_int32(ep - size_p, size_p); } goto outer_loop; + case ENC_BIN_COPY: { + Uint bits = (Uint)obj; + Uint bitoffs = WSTACK_POP(s); + byte* bytes = (byte*) WSTACK_POP(s); + byte* dst = (byte*) WSTACK_POP(s); + if (bits > r * (TERM_TO_BINARY_MEMCPY_FACTOR * 8)) { + Uint n = r * TERM_TO_BINARY_MEMCPY_FACTOR; + WSTACK_PUSH5(s, (UWord)(dst + n), (UWord)(bytes + n), bitoffs, + ENC_BIN_COPY, bits - 8*n); + bits = 8*n; + copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits); + obj = THE_NON_VALUE; + r = 0; /* yield */ + break; + } else { + copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits); + r -= bits / (TERM_TO_BINARY_MEMCPY_FACTOR * 8); + goto outer_loop; + } + } + case ENC_MAP_PAIR: { + Uint pairs_left = obj; + Eterm *vptr = (Eterm*) WSTACK_POP(s); + Eterm *kptr = (Eterm*) WSTACK_POP(s); + + obj = *kptr; + if (--pairs_left > 0) { + WSTACK_PUSH4(s, (UWord)(kptr+1), (UWord)(vptr+1), + ENC_MAP_PAIR, pairs_left); + } + 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 */ { @@ -2419,17 +2441,16 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, #else Eterm* ptr = (Eterm *) obj; #endif - WSTACK_PUSH(s, val-1); obj = *ptr++; - WSTACK_PUSH(s, (UWord)ptr); + WSTACK_PUSH2(s, val-1, (UWord)ptr); } break; } L_jump_start: - if (ctx && --r == 0) { - *reds = r; + if (ctx && --r <= 0) { + *reds = 0; ctx->obj = obj; ctx->ep = ep; WSTACK_SAVE(s, &ctx->wstack); @@ -2578,39 +2599,59 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep += 4; } if (i > 0) { - WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); - WSTACK_PUSH(s, (UWord)ptr); + WSTACK_PUSH2(s, ENC_LAST_ARRAY_ELEMENT+i-1, (UWord)ptr); } 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); - - for (i = size-1; i >= 1; i--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) vptr[i]); - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) kptr[i]); - } + Eterm *kptr = flatmap_get_keys(mp); + Eterm *vptr = flatmap_get_values(mp); - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) vptr[0]); + 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"); + } - obj = kptr[0]; - goto L_jump_start; + 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) { @@ -2644,6 +2685,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint bitoffs; Uint bitsize; byte* bytes; + byte* data_dst; ERTS_GET_BINARY_BYTES(obj, bytes, bitoffs, bitsize); if (dflags & DFLAG_INTERNAL_TAGS) { @@ -2689,7 +2731,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, j = binary_size(obj); put_int32(j, ep); ep += 4; - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j); + data_dst = ep; ep += j; } else if (dflags & DFLAG_BIT_BINARIES) { /* Bit-level binary. */ @@ -2699,7 +2741,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep += 4; *ep++ = bitsize; ep[j] = 0; /* Zero unused bits at end of binary */ - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + data_dst = ep; ep += j + 1; } else { /* @@ -2713,11 +2755,18 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, put_int32((j+1), ep); ep += 4; ep[j] = 0; /* Zero unused bits at end of binary */ - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + data_dst = ep; ep += j+1; *ep++ = SMALL_INTEGER_EXT; *ep++ = bitsize; } + if (ctx && j > r * TERM_TO_BINARY_MEMCPY_FACTOR) { + WSTACK_PUSH5(s, (UWord)data_dst, (UWord)bytes, bitoffs, + ENC_BIN_COPY, 8*j + bitsize); + } else { + copy_binary_to_buffer(data_dst, 0, bytes, bitoffs, + 8 * j + bitsize); + } } break; case EXPORT_DEF: @@ -2746,13 +2795,12 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case FUN_DEF: { ErlFunThing* funp = (ErlFunThing *) fun_val(obj); + int ei; if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { - int ei; - *ep++ = NEW_FUN_EXT; - WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE); - WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE, + (UWord) ep); /* Position for patching in size */ ep += 4; *ep = funp->arity; ep += 1; @@ -2766,16 +2814,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); ep = enc_pid(acmp, funp->creator, ep, dflags); - - fun_env: - for (ei = funp->num_free-1; ei > 0; ei--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) funp->env[ei]); - } - if (funp->num_free != 0) { - obj = funp->env[0]; - goto L_jump_start; - } } else { /* * Communicating with an obsolete erl_interface or @@ -2807,7 +2845,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, *ep++ = SMALL_TUPLE_EXT; put_int8(funp->num_free, ep); ep += 1; - goto fun_env; + } + for (ei = funp->num_free-1; ei > 0; ei--) { + WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]); + } + if (funp->num_free != 0) { + obj = funp->env[0]; + goto L_jump_start; } } break; @@ -2889,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, @@ -2901,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; @@ -2911,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; @@ -2992,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; @@ -3389,8 +3446,6 @@ dec_term_atom_common: } else { Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; hp += PROC_BIN_SIZE; @@ -3398,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; @@ -3443,14 +3499,13 @@ dec_term_atom_common: Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; pb->thing_word = HEADER_PROC_BIN; 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; @@ -3532,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: @@ -3749,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; @@ -3766,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; @@ -3792,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; } @@ -3807,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) { @@ -3855,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)) { @@ -3982,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: @@ -4098,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; } @@ -4139,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) { @@ -4343,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 10565f67e5..50fcfa04d6 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -150,6 +150,7 @@ typedef struct { Uint extsize; } ErtsBinary2TermState; + /* -------------------------------------------------------------------------- */ void erts_init_atom_cache_map(ErtsAtomCacheMap *); @@ -160,8 +161,12 @@ void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32); Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32); -Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); -void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); +struct erts_dsig_send_context; +int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); +int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp); +struct TTBEncodeContext_; +int erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *, + struct TTBEncodeContext_ *, Sint* reds); Uint erts_encode_ext_size(Eterm); Uint erts_encode_ext_size_2(Eterm, unsigned); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 32a2dc43e8..340c7033ab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -41,6 +41,7 @@ #include "error.h" #include "erl_utils.h" #include "erl_port.h" +#include "erl_gc.h" struct enif_environment_t /* ErlNifEnv */ { @@ -51,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*); @@ -347,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; @@ -371,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) @@ -390,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) @@ -416,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)\ @@ -444,72 +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_COUNT(s) (s.sp - s.start) -#define ESTACK_ISEMPTY(s) (s.sp == s.start) -#define ESTACK_POP(s) (*(--s.sp)) +#define ESTACK_PUSH4(s, E1, E2, E3, E4) \ +do { \ + if ((s).sp > (s).end - 4) { \ + erl_grow_estack(&s, 4); \ + } \ + *(s).sp++ = (E1); \ + *(s).sp++ = (E2); \ + *(s).sp++ = (E3); \ + *(s).sp++ = (E4); \ +} while(0) + +#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 { \ @@ -520,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 @@ -541,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;\ @@ -569,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) @@ -582,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); \ @@ -590,17 +643,129 @@ 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); \ *s.wsp++ = (z); \ } while(0) +#define WSTACK_PUSH4(s, A1, A2, A3, A4) \ +do { \ + if (s.wsp > s.wend - 4) { \ + erl_grow_wstack(&s, 4); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ +} while(0) + +#define WSTACK_PUSH5(s, A1, A2, A3, A4, A5) \ +do { \ + if (s.wsp > s.wend - 5) { \ + erl_grow_wstack(&s, 5); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ + *s.wsp++ = (A5); \ +} while(0) + +#define WSTACK_PUSH6(s, A1, A2, A3, A4, A5, A6) \ +do { \ + if (s.wsp > s.wend - 6) { \ + erl_grow_wstack(&s, 6); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ + *s.wsp++ = (A5); \ + *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 */ @@ -623,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]); @@ -705,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*, ...); @@ -810,23 +975,6 @@ void MD5Init(MD5_CTX *); void MD5Update(MD5_CTX *, unsigned char *, unsigned int); void MD5Final(unsigned char [16], MD5_CTX *); -/* ggc.c */ - -void erts_gc_info(ErtsGCInfo *gcip); -void erts_init_gc(void); -int erts_garbage_collect(Process*, int, Eterm*, int); -void erts_garbage_collect_hibernate(Process* p); -Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity); -void erts_garbage_collect_literals(Process* p, Eterm* literals, - Uint lit_size, - struct erl_off_heap_header* oh); -Uint erts_next_heap_size(Uint, Uint); -Eterm erts_heap_sizes(Process* p); - -void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*); -void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_free_heap_frags(Process* p); /* io.c */ @@ -1161,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 @@ -1181,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 7c6696405b..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; @@ -391,7 +389,7 @@ static Port *create_port(char *name, /* Set default tracing */ erts_get_default_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER_PROC(prt)); - ASSERT(((char *) prt) == ((char *) &prt->common)); + ERTS_CT_ASSERT(offsetof(Port,common) == 0); #if !ERTS_PORT_INIT_INSTR_NEED_ID /* @@ -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; @@ -3153,8 +3132,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, Binary* bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, buf, len); @@ -3187,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); } /* @@ -3281,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; @@ -3358,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); } @@ -3455,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)) { @@ -5006,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; @@ -5052,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; @@ -5062,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 @@ -5352,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++; @@ -5382,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; @@ -5507,8 +5455,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ProcBin* pbp; Binary* bp = erts_bin_nrml_alloc(size); ASSERT(bufp); - bp->flags = 0; - bp->orig_size = (SWord) size; erts_refc_init(&bp->refc, 1); sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); pbp = (ProcBin *) hp; @@ -5582,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; @@ -5598,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; } @@ -5643,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) @@ -5660,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; @@ -6000,9 +5963,7 @@ driver_alloc_binary(ErlDrvSizeT size) bin = erts_bin_drv_alloc_fnf((Uint) size); if (!bin) return NULL; /* The driver write must take action */ - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) size; return Binary2ErlDrvBinary(bin); } @@ -6032,7 +5993,6 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) if (!newbin) return NULL; - newbin->orig_size = size; return Binary2ErlDrvBinary(newbin); } @@ -6616,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); @@ -6639,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; } @@ -6661,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; } @@ -6706,7 +6643,7 @@ static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) { RefThing *refp; ASSERT(is_internal_ref(ref)); - ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor)); + ERTS_CT_ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor)); refp = ref_thing_ptr(ref); memset(mon,0,sizeof(ErlDrvMonitor)); memcpy(mon,refp,sizeof(RefThing)); 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 c29d4b3777..cd53069872 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,32 @@ __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) + */ +#if ERTS_AT_LEAST_GCC_VSN__(3,1,1) +# define ERTS_CT_ASSERT(e) \ + do { \ + enum { compile_time_assert__ = __builtin_choose_expr((e),0,(void)0) }; \ + } while(0) +#else +# define ERTS_CT_ASSERT(e) \ + do { \ + enum { compile_time_assert__ = 1/(e) }; \ + } while (0) +#endif + /* * Microsoft C/C++: We certainly want to use stdarg.h and prototypes. * But MSC doesn't define __STDC__, unless we compile with the -Za @@ -359,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 @@ -600,6 +657,7 @@ erts_dsprintf_buf_t *erts_create_logger_dsbuf(void); int erts_send_info_to_logger(Eterm, erts_dsprintf_buf_t *); int erts_send_warning_to_logger(Eterm, erts_dsprintf_buf_t *); int erts_send_error_to_logger(Eterm, erts_dsprintf_buf_t *); +int erts_send_error_term_to_logger(Eterm, erts_dsprintf_buf_t *, Eterm); int erts_send_info_to_logger_str(Eterm, char *); int erts_send_warning_to_logger_str(Eterm, char *); int erts_send_error_to_logger_str(Eterm, char *); @@ -646,14 +704,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); @@ -696,11 +777,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 @@ -739,6 +818,8 @@ int univ_to_local( int local_to_univ(Sint *year, Sint *month, Sint *day, Sint *hour, Sint *minute, Sint *second, int isdst); void get_now(Uint*, Uint*, Uint*); +struct ErtsSchedulerData_; +ErtsMonotonicTime erts_get_monotonic_time(struct ErtsSchedulerData_ *); void get_sys_now(Uint*, Uint*, Uint*); void set_break_quit(void (*)(void), void (*)(void)); @@ -756,6 +837,8 @@ typedef struct { } ErtsCheckIoDebugInfo; int erts_check_io_debug(ErtsCheckIoDebugInfo *ip); +int erts_sys_is_area_readable(char *start, char *stop); + /* xxxP */ #define SYS_DEFAULT_FLOAT_DECIMALS 20 void init_sys_float(void); @@ -784,6 +867,11 @@ int erts_sys_unsetenv(char *key); char *erts_read_env(char *key); void erts_free_read_env(void *value); +#if defined(ERTS_THR_HAVE_SIG_FUNCS) && !defined(ETHR_UNUSABLE_SIGUSRX) +extern void sys_thr_resume(erts_tid_t tid); +extern void sys_thr_suspend(erts_tid_t tid); +#endif + /* utils.c */ /* Options to sys_alloc_opt */ diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 2fd8e0cf00..8bffdedb2b 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -76,6 +76,11 @@ #include "sys.h" #include "erl_vm.h" #include "global.h" +#define ERTS_WANT_TIMER_WHEEL_API +#include "erl_time.h" + +#define ERTS_MONOTONIC_DAY ERTS_SEC_TO_MONOTONIC(60*60*24) +#define ERTS_CLKTCKS_DAY ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY) #ifdef ERTS_ENABLE_LOCK_CHECK #define ASSERT_NO_LOCKED_LOCKS erts_lc_check_exact(NULL, 0) @@ -83,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,437 @@ 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) +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; +}; + +static ERTS_INLINE ErtsMonotonicTime +find_next_timeout(ErtsSchedulerData *esdp, + ErtsTimerWheel *tiw, + int search_all, + ErtsMonotonicTime curr_time, /* When !search_all */ + ErtsMonotonicTime max_search_time) /* When !search_all */ { - return erts_smp_atomic32_read_acqb(&do_time); -} - -static ERTS_INLINE erts_short_time_t do_time_update(void) -{ - return do_time_read(); -} + int start_ix, tiw_pos_ix; + ErtsTWheelTimer *p; + int true_min_timeout = 0; + ErtsMonotonicTime min_timeout, min_timeout_pos, slot_timeout_pos; + + if (tiw->nto == 0) { /* no timeouts in wheel */ + if (!search_all) + min_timeout_pos = tiw->pos; + else { + curr_time = erts_get_monotonic_time(esdp); + tiw->pos = min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time); + } + min_timeout_pos += ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY); + goto found_next; + } -static ERTS_INLINE void do_time_init(void) -{ - erts_smp_atomic32_init_nob(&do_time, 0); -} + slot_timeout_pos = min_timeout_pos = tiw->pos; + if (search_all) + min_timeout_pos += ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_DAY); + else + min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time + max_search_time); -/* get the time (in units of TIW_ITIME) to the next timeout, - or -1 if there are no timeouts */ + start_ix = tiw_pos_ix = (int) (tiw->pos & (ERTS_TIW_SIZE-1)); -static erts_short_time_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ -{ - 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); - } - - /* start going through wheel to find next timeout */ - tm = nto = 0; - min = (Uint32) -1; /* max Uint32 */ - i = tiw_pos; 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; + if (++slot_timeout_pos >= min_timeout_pos) + 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; + } +} - /* last */ - if (!p->next) { +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); + + if (p->next == p) { + ERTS_TW_ASSERT(tiw->w[slot] == p); + tiw->w[slot] = NULL; + } + else { + if (tiw->w[slot] == p) + tiw->w[slot] = p->next; + p->prev->next = p->next; + p->next->prev = p->prev; + } + } + else { + /* Timer in "at once" queue... */ + ERTS_TW_ASSERT(slot == ERTS_TWHEEL_SLOT_AT_ONCE); if (p->prev) - p->prev->next = NULL; - } else { - p->next->prev = p->prev; + p->prev->next = p->next; + else { + ERTS_TW_ASSERT(tiw->at_once.head == p); + tiw->at_once.head = p->next; + } + if (p->next) + p->next->prev = p->prev; + else { + ERTS_TW_ASSERT(tiw->at_once.tail == p); + tiw->at_once.tail = p->prev; + } + ERTS_TW_ASSERT(tiw->at_once.nto > 0); + tiw->at_once.nto--; } - p->next = NULL; - p->prev = NULL; - /* Make sure cancel callback isn't called */ - p->active = 0; - tiw_nto--; + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; + + 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; + ErtsTimerWheel *tiw = esdp->timer_wheel; + if (tiw->true_next_timeout_time) + return tiw->next_timeout_time; + return find_next_timeout(esdp, tiw, 1, 0, 0); +} - 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 +timeout_timer(ErtsTWheelTimer *p) +{ + ErlTimeoutProc timeout; + void *arg; + p->slot = ERTS_TWHEEL_SLOT_INACTIVE; + timeout = p->u.func.timeout; + arg = p->u.func.arg; + (*timeout)(arg); + ASSERT_NO_LOCKED_LOCKS; } -static ERTS_INLINE void bump_timer_internal(erts_short_time_t dt) /* PRE: tiw_lock is write-locked */ +void +erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { - 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; + 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; } - else { - /* no timeout, just decrease counter */ - p->count -= count; - prev = &p->next; + + 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; + } + } + + 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(NULL, tiw, 0, 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 +556,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; + p->u.func.timeout = timeout; + p->u.func.cancel = cancel; + p->u.func.arg = arg; - /* - * 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; - - - /* 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; - } + ERTS_TW_ASSERT(p->slot == ERTS_TWHEEL_SLOT_INACTIVE); - tiw_nto++; -} + 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; -void -erts_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, - void* arg, Uint t) -{ + /* calculate slot */ + slot = (int) (timeout_pos & (ERTS_TIW_SIZE-1)); - 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 -} + insert_timer_into_slot(tiw, slot, p); -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; - } + tiw->nto++; - /* is it the 'min' timer, remove min */ - if (p == tiw_min_ptr) { - tiw_min_ptr = NULL; - tiw_min = 0; + timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(timeout_pos); + p->timeout_pos = timeout_pos; } - remove_timer(p); - p->slot = p->count = 0; - - if (p->cancel != NULL) { - erts_smp_mtx_unlock(&tiw_lock); - (*p->cancel)(p->arg); - return; + if (timeout_time < tiw->next_timeout_time) { + tiw->true_next_timeout_time = 1; + tiw->next_timeout_time = timeout_time; } - 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 f810fca9a4..cecd88197e 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -49,6 +49,12 @@ #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 #undef M_TRIM_THRESHOLD #undef M_TOP_PAD @@ -187,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 { @@ -207,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 { @@ -224,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 @@ -311,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, ...) { @@ -789,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 @@ -902,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)) { @@ -972,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); @@ -1092,11 +1135,12 @@ 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); -/* (HCONST * {2, ..., 16}) mod 2^32 */ + ERTS_UNDEF(hash_xor_pairs, 0); + +/* (HCONST * {2, ..., 22}) mod 2^32 */ #define HCONST_2 0x3c6ef372UL #define HCONST_3 0xdaa66d2bUL #define HCONST_4 0x78dde6e4UL @@ -1112,10 +1156,16 @@ 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 HCONST_22 0x98c475e6UL #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 { \ @@ -1138,6 +1188,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) { @@ -1192,9 +1249,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; @@ -1211,51 +1268,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); + for (i = arity; ; i--) { + term = elem[i]; + if (i == 1) + break; + ESTACK_PUSH(s, term); } - 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_PUSH(s, hash_xor_values); - ESTACK_PUSH(s, hash_xor_keys); - ESTACK_PUSH(s, hash); - ESTACK_PUSH(s, HASH_MAP_TAIL); - hash = 0; - hash_xor_keys = 0; - hash_xor_values = 0; - for (i = size - 1; i >= 0; i--) { - tmp = vs[i]; - ESTACK_PUSH(s, HASH_MAP_VAL); - ESTACK_PUSH(s, 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_PUSH(s, HASH_MAP_KEY); - ESTACK_PUSH(s, tmp); - } - 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, @@ -1270,7 +1366,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, @@ -1351,7 +1446,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); @@ -1384,6 +1480,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 @@ -1459,20 +1559,397 @@ 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_2(sh, (Uint32)c, HCONST_22); + + 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; } @@ -1480,9 +1957,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 @@ -1613,12 +2091,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)) { @@ -1699,23 +2180,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); @@ -1758,101 +2224,157 @@ tail_recur: #undef MAKE_HASH_CDR_POST_OP } -static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +static Eterm +do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp, + ErlHeapFragment **bp, Process **p, Uint sz) { - /* error_logger ! - {notify,{info_msg,gleader,{emulator,"~s~n",[<message as list>]}}} | - {notify,{error,gleader,{emulator,"~s~n",[<message as list>]}}} | - {notify,{warning_msg,gleader,{emulator,"~s~n",[<message as list>}]}} */ - Eterm* hp; - Uint sz; Uint gl_sz; - Eterm gl; - Eterm list,plist,format,tuple1,tuple2,tuple3; - ErlOffHeap *ohp; - ErlHeapFragment *bp = NULL; -#if !defined(ERTS_SMP) - Process *p; -#endif - - ASSERT(is_atom(tag)); - - if (len <= 0) { - return -1; - } + gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader); + sz = sz + gl_sz; #ifndef ERTS_SMP #ifdef USE_THREADS - p = NULL; if (erts_get_scheduler_data()) /* Must be scheduler thread */ #endif { - p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0); - if (p) { - erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state); + *p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0); + if (*p) { + erts_aint32_t state = erts_smp_atomic32_read_acqb(&(*p)->state); if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)) - p = NULL; + *p = NULL; } } - if (!p) { - /* buf *always* points to a null terminated string */ - erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n", - tag, buf); - return 0; + if (!*p) { + return NIL; } - /* So we have an error logger, lets build the message */ -#endif - gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader); - sz = len * 2 /* message list */+ 2 /* cons surrounding message list */ - + gl_sz + - 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ + - 8 /* "~s~n" */; -#ifndef ERTS_SMP - if (sz <= HeapWordsLeft(p)) { - ohp = &MSO(p); - hp = HEAP_TOP(p); - HEAP_TOP(p) += sz; + /* So we have an error logger, lets build the message */ + if (sz <= HeapWordsLeft(*p)) { + *ohp = &MSO(*p); + *hp = HEAP_TOP(*p); + HEAP_TOP(*p) += sz; } else { #endif - bp = new_message_buffer(sz); - ohp = &bp->off_heap; - hp = bp->mem; + *bp = new_message_buffer(sz); + *ohp = &(*bp)->off_heap; + *hp = (*bp)->mem; #ifndef ERTS_SMP } #endif - gl = (is_nil(gleader) + + return (is_nil(gleader) ? am_noproc : (IS_CONST(gleader) ? gleader - : copy_struct(gleader,gl_sz,&hp,ohp))); - list = buf_to_intlist(&hp, buf, len, NIL); - plist = CONS(hp,list,NIL); - hp += 2; - format = buf_to_intlist(&hp, "~s~n", 4, NIL); - tuple1 = TUPLE3(hp, am_emulator, format, plist); - hp += 4; - tuple2 = TUPLE3(hp, tag, gl, tuple1); - hp += 4; - tuple3 = TUPLE2(hp, am_notify, tuple2); + : copy_struct(gleader,gl_sz,hp,*ohp))); +} + +static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *bp, + Process *p, Eterm message) +{ #ifdef HARDDEBUG - erts_fprintf(stderr, "%T\n", tuple3); + erts_fprintf(stderr, "%T\n", message); #endif #ifdef ERTS_SMP { Eterm from = erts_get_current_pid(); if (is_not_internal_pid(from)) from = NIL; - erts_queue_error_logger_message(from, tuple3, bp); + erts_queue_error_logger_message(from, message, bp); } #else - erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL -#ifdef USE_VM_PROBES - , NIL -#endif - ); + erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL); #endif +} + +/* error_logger ! + {notify,{info_msg,gleader,{emulator,format,[args]}}} | + {notify,{error,gleader,{emulator,format,[args]}}} | + {notify,{warning_msg,gleader,{emulator,format,[args}]}} */ +static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +{ + Uint sz; + Eterm gl; + Eterm list,args,format,tuple1,tuple2,tuple3; + + Eterm *hp = NULL; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + Process *p = NULL; + + ASSERT(is_atom(tag)); + + if (len <= 0) { + return -1; + } + + sz = len * 2 /* message list */ + 2 /* cons surrounding message list */ + + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ + + 8 /* "~s~n" */; + + /* gleader size is accounted and allocated next */ + gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz); + + if(is_nil(gl)) { + /* buf *always* points to a null terminated string */ + erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n", + tag, buf); + return 0; + } + + list = buf_to_intlist(&hp, buf, len, NIL); + args = CONS(hp,list,NIL); + hp += 2; + format = buf_to_intlist(&hp, "~s~n", 4, NIL); + tuple1 = TUPLE3(hp, am_emulator, format, args); + hp += 4; + tuple2 = TUPLE3(hp, tag, gl, tuple1); + hp += 4; + tuple3 = TUPLE2(hp, am_notify, tuple2); + + do_send_logger_message(hp, ohp, bp, p, tuple3); + return 0; +} + +static int do_send_term_to_logger(Eterm tag, Eterm gleader, + char *buf, int len, Eterm args) +{ + Uint sz; + Eterm gl; + Uint args_sz; + Eterm format,tuple1,tuple2,tuple3; + + Eterm *hp = NULL; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + Process *p = NULL; + + ASSERT(is_atom(tag)); + + args_sz = size_object(args); + sz = len * 2 /* format */ + args_sz + + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */; + + /* gleader size is accounted and allocated next */ + gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz); + + if(is_nil(gl)) { + /* buf *always* points to a null terminated string */ + erts_fprintf(stderr, "(no error logger present) %T: \"%s\" %T\n", + tag, buf, args); + return 0; + } + + format = buf_to_intlist(&hp, buf, len, NIL); + args = copy_struct(args, args_sz, &hp, ohp); + tuple1 = TUPLE3(hp, am_emulator, format, args); + hp += 4; + tuple2 = TUPLE3(hp, tag, gl, tuple1); + hp += 4; + tuple3 = TUPLE2(hp, am_notify, tuple2); + + do_send_logger_message(hp, ohp, bp, p, tuple3); return 0; } @@ -1880,6 +2402,12 @@ send_error_to_logger(Eterm gleader, char *buf, int len) return do_send_to_logger(am_error, gleader, buf, len); } +static ERTS_INLINE int +send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args) +{ + return do_send_term_to_logger(am_error, gleader, buf, len, args); +} + #define LOGGER_DSBUF_INC_SZ 256 static erts_dsprintf_buf_t * @@ -1955,6 +2483,15 @@ erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp) } int +erts_send_error_term_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp, Eterm args) +{ + int res; + res = send_error_term_to_logger(gleader, dsbufp->str, dsbufp->str_len, args); + destroy_logger_dsbuf(dsbufp); + return res; +} + +int erts_send_info_to_logger_str(Eterm gleader, char *str) { return send_info_to_logger(gleader, str, sys_strlen(str)); @@ -2120,22 +2657,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: @@ -2327,6 +2848,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; } @@ -2436,21 +2997,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; @@ -2466,6 +3074,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 @@ -2481,6 +3109,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; @@ -2607,25 +3237,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; @@ -2985,8 +3686,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; } } @@ -2998,22 +3698,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 @@ -3663,145 +4520,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; @@ -3811,9 +4529,7 @@ Uint tot_bin_allocated; void erts_init_utils(void) { -#ifdef ERTS_SMP - init_ptimers(); -#endif + } void erts_init_utils_mem(void) @@ -4353,8 +5069,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 3b8e7acb6e..b2cfe70f94 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1616,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; @@ -1695,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 { @@ -1708,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 */ @@ -1938,6 +1938,8 @@ static void invoke_sendfile(void *data) d->result_ok = 1; if (d->c.sendfile.nbytes != 0) d->c.sendfile.nbytes -= nbytes; + } else if (nbytes == 0 && d->c.sendfile.nbytes == 0) { + d->result_ok = 1; } else d->result_ok = 0; } else { diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 3c6922eb8e..10ef20fc82 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -293,6 +293,10 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); static unsigned long zero_value = 0; static unsigned long one_value = 1; +#define TCP_SHUT_WR SD_SEND +#define TCP_SHUT_RD SD_RECEIVE +#define TCP_SHUT_RDWR SD_BOTH + #elif defined (__OSE__) /* @@ -421,6 +425,10 @@ typedef unsigned long u_long; inet_driver_select((d), (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR + #else /* !__OSE__ && !__WIN32__ */ #include <sys/time.h> @@ -691,6 +699,9 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR #endif /* !__WIN32__ && !__OSE__ */ @@ -820,6 +831,10 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define TCP_ADDF_CLOSE_SENT 2 /* Close sent (active mode only) */ #define TCP_ADDF_DELAYED_CLOSE_RECV 4 /* If receive fails, report {error,closed} (passive mode) */ #define TCP_ADDF_DELAYED_CLOSE_SEND 8 /* If send fails, report {error,closed} (passive mode) */ +#define TCP_ADDF_PENDING_SHUT_WR 16 /* Call shutdown(sock, SHUT_WR) when queue empties */ +#define TCP_ADDF_PENDING_SHUT_RDWR 32 /* Call shutdown(sock, SHUT_RDWR) when queue empties */ +#define TCP_ADDF_PENDING_SHUTDOWN \ + (TCP_ADDF_PENDING_SHUT_WR | TCP_ADDF_PENDING_SHUT_RDWR) /* *_REQ_* replies */ #define INET_REP_ERROR 0 @@ -1407,6 +1422,8 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev); static int tcp_recv(tcp_descriptor* desc, int request_len); static int tcp_deliver(tcp_descriptor* desc, int len); +static int tcp_shutdown_error(tcp_descriptor* desc, int err); + static int tcp_inet_output(tcp_descriptor* desc, HANDLE event); static int tcp_inet_input(tcp_descriptor* desc, HANDLE event); @@ -3957,9 +3974,9 @@ static int inet_init() if (0 != erl_drv_tsd_key_create("inet_buffer_stack_key", &buffer_stack_key)) goto error; - ASSERT(sizeof(struct in_addr) == 4); + ERTS_CT_ASSERT(sizeof(struct in_addr) == 4); # if defined(HAVE_IN6) && defined(AF_INET6) - ASSERT(sizeof(struct in6_addr) == 16); + ERTS_CT_ASSERT(sizeof(struct in6_addr) == 16); # endif INIT_ATOM(ok); @@ -4005,7 +4022,7 @@ static int inet_init() #ifdef HAVE_SCTP /* Check the size of SCTP AssocID -- currently both this driver and the Erlang part require 32 bit: */ - ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN); + ERTS_CT_ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN); # if defined(HAVE_SCTP_BINDX) p_sctp_bindx = sctp_bindx; # if defined(HAVE_SCTP_PEELOFF) @@ -9473,10 +9490,18 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, return ctl_error(EINVAL, rbuf, rsize); } how = buf[0]; - if (sock_shutdown(INETP(desc)->s, how) == 0) { + if (how != TCP_SHUT_RD && driver_sizeq(desc->inet.port) > 0) { + if (how == TCP_SHUT_WR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_WR; + } else if (how == TCP_SHUT_RDWR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_RDWR; + } return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); - } else { + } + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) { return ctl_error(sock_errno(), rbuf, rsize); + } else { + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); } } default: @@ -9613,6 +9638,8 @@ static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) else inet_reply_error(INETP(desc), ENOTCONN); } + else if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_error(desc, EPIPE); else if (tcp_sendv(desc, ev) == 0) inet_reply_ok(INETP(desc)); DEBUGF(("tcp_inet_commandv(%ld) }\r\n", (long)desc->inet.port)); @@ -10506,7 +10533,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) return ret; } -static int tcp_send_error(tcp_descriptor* desc, int err) +static int tcp_send_or_shutdown_error(tcp_descriptor* desc, int err) { /* * If the port is busy, we must do some clean-up before proceeding. @@ -10563,6 +10590,16 @@ static int tcp_send_error(tcp_descriptor* desc, int err) return -1; } +static int tcp_send_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + +static int tcp_shutdown_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + /* ** Send non-blocking vector data */ @@ -10763,6 +10800,19 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len) return 0; } +/* shutdown on the socket: +** Assume caller has confirmed TCP_ADDF_PENDING_SHUTDOWN is set. +*/ +static void tcp_shutdown_async(tcp_descriptor* desc) +{ + int how; + + how = (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUT_WR) ? + TCP_SHUT_WR : TCP_SHUT_RDWR; + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) + tcp_shutdown_error(desc, sock_errno()); +} + #ifdef __OSE__ static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event) @@ -10891,6 +10941,8 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) if ((iov = driver_peekq(ix, &vsize)) == NULL) { sock_select(INETP(desc), FD_WRITE, 0); send_empty_out_q_msgs(INETP(desc)); + if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_async(desc); goto done; } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -12120,6 +12172,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, void (*timeout_fun)(ErlDrvData drv_data, ErlDrvTermData caller)) { +#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs) +#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs) MultiTimerData *mtd, *p, *s; mtd = ALLOC(sizeof(MultiTimerData)); absolute_timeout(timeout, &(mtd->when)); @@ -12131,23 +12185,17 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, break; } } - if (!p || p->when.megasecs > mtd->when.megasecs) { - goto found; - } - for (; p!= NULL; s = p, p = p->next) { + for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) { if (p->when.secs >= mtd->when.secs) { break; } } - if (!p || p->when.secs > mtd->when.secs) { - goto found; - } - for (; p!= NULL; s = p, p = p->next) { + for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) { if (p->when.microsecs >= mtd->when.microsecs) { break; } } - found: + if (!p) { if (!s) { *first = mtd; @@ -12173,6 +12221,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, } return mtd; } +#undef eq_mega +#undef eq_sec 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/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 491e0a090e..a5960716f2 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -32,6 +32,10 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */ +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif + #include "sys.h" #include <ctype.h> #include <stdlib.h> @@ -39,6 +43,7 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <string.h> #include <signal.h> #include <fcntl.h> +#include <limits.h> #include <locale.h> #include <unistd.h> #include <termios.h> @@ -57,6 +62,14 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <langinfo.h> #endif +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + #define TRUE 1 #define FALSE 0 @@ -80,12 +93,15 @@ static volatile int cols_needs_update = FALSE; #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 #define CTRL_OP_GET_UNICODE_STATE 101 #define CTRL_OP_SET_UNICODE_STATE 102 - +/* We use 1024 as the buf size as that was the default buf size of FILE streams + on all platforms that I checked. */ +#define TTY_BUFFSIZE 1024 static int lbuf_size = BUFSIZ; static Uint32 *lbuf; /* The current line buffer */ @@ -113,13 +129,19 @@ static int lpos; /* The current "cursor position" in the line buf /* Main interface functions. */ static void ttysl_stop(ErlDrvData); static void ttysl_from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static void ttysl_to_tty(ErlDrvData, ErlDrvEvent); +static void ttysl_flush_tty(ErlDrvData); static void ttysl_from_tty(ErlDrvData, ErlDrvEvent); static void ttysl_stop_select(ErlDrvEvent, void*); static Sint16 get_sint16(char*); static ErlDrvPort ttysl_port; static int ttysl_fd; -static FILE *ttysl_out; +static int ttysl_terminate = 0; +static int ttysl_send_ok = 0; +static ErlDrvBinary *putcbuf; +static int putcpos; +static int putclen; /* Functions that work on the line buffer. */ static int start_lbuf(void); @@ -201,22 +223,22 @@ struct erl_drv_entry ttsl_driver_entry = { IF_IMPL(ttysl_stop), IF_IMPL(ttysl_from_erlang), IF_IMPL(ttysl_from_tty), - NULL, - "tty_sl", - NULL, - NULL, + IF_IMPL(ttysl_to_tty), + "tty_sl", /* driver_name */ + NULL, /* finish */ + NULL, /* handle */ IF_IMPL(ttysl_control), NULL, /* timeout */ NULL, /* outputv */ NULL, /* ready_async */ - NULL, /* flush */ + IF_IMPL(ttysl_flush_tty), NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, 0, /* ERL_DRV_FLAGs */ - NULL, + NULL, /* handle2 */ NULL, /* process_exit */ IF_IMPL(ttysl_stop_select) }; @@ -296,8 +318,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) return ERL_DRV_ERROR_GENERAL; } - /* Open the terminal and set the terminal */ - ttysl_out = fdopen(ttysl_fd, "w"); + SET_NONBLOCKING(ttysl_fd); #ifdef PRIMITIVE_UTF8_CHECK setlocale(LC_CTYPE, ""); /* Set international environment, @@ -317,8 +338,8 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) } #endif DEBUGLOG(("utf8_mode is %s\n",(utf8_mode) ? "on" : "off")); - sys_sigset(SIGCONT, cont); - sys_sigset(SIGWINCH, winch); + sys_signal(SIGCONT, cont); + sys_signal(SIGWINCH, winch); driver_select(port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 1); ttysl_port = port; @@ -400,12 +421,14 @@ static void ttysl_stop(ErlDrvData ttysl_data) stop_lbuf(); stop_termcap(); tty_reset(ttysl_fd); - driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0); - sys_sigset(SIGCONT, SIG_DFL); - sys_sigset(SIGWINCH, SIG_DFL); + driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, + ERL_DRV_WRITE|ERL_DRV_READ|ERL_DRV_USE, 0); + sys_signal(SIGCONT, SIG_DFL); + sys_signal(SIGWINCH, SIG_DFL); } ttysl_port = (ErlDrvPort)-1; ttysl_fd = -1; + ttysl_terminate = 0; /* return TRUE; */ } @@ -650,10 +673,26 @@ static int check_buf_size(byte *s, int n) static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT count) { + ErlDrvSizeT sz; + + sz = driver_sizeq(ttysl_port); + + putclen = count > TTY_BUFFSIZE ? TTY_BUFFSIZE : count; + putcbuf = driver_alloc_binary(putclen); + putcpos = 0; + if (lpos > MAXSIZE) put_chars((byte*)"\n", 1); switch (buf[0]) { + case OP_PUTC_SYNC: + /* Using sync means that we have to send an ok to the + controlling process for each command call. We delay + sending ok if the driver queue exceeds a certain size. + We do not set ourselves as a busy port, as this + could be very bad for user_drv, if it gets blocked on + the port_command. */ + /* fall through */ case OP_PUTC: DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) @@ -678,10 +717,104 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } - fflush(ttysl_out); + + driver_enq_bin(ttysl_port,putcbuf,0,putcpos); + + if (sz == 0) { + for (;;) { + int written, qlen; + SysIOVec *iov; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_USE|ERL_DRV_WRITE,1); + break; + } else { + /* we ignore all other errors */ + break; + } + } else { + if (driver_deq(ttysl_port, written) == 0) + break; + } + } + } + + if (buf[0] == OP_PUTC_SYNC) { + if (driver_sizeq(ttysl_port) > TTY_BUFFSIZE && !ttysl_terminate) { + /* We delay sending the ack until the buffer has been consumed */ + ttysl_send_ok = 1; + } else { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ASSERT(ttysl_send_ok == 0); + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + } + return; /* TRUE; */ } +static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { + for (;;) { + int written, qlen; + SysIOVec *iov; + ErlDrvSizeT sz; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + break; + } else { + /* we ignore all other errors */ + } + } else { + sz = driver_deq(ttysl_port, written); + if (sz < TTY_BUFFSIZE && ttysl_send_ok) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ttysl_send_ok = 0; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + if (sz == 0) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_WRITE,0); + if (ttysl_terminate) + /* flush has been called, which means we should terminate + when queue is empty. This will not send any exit + message */ + driver_failure_atom(ttysl_port, "normal"); + break; + } + } + } + + return; +} + +static void ttysl_flush_tty(ErlDrvData ttysl_data) { + ttysl_terminate = 1; + return; +} + static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { byte b[1024]; @@ -1070,7 +1203,14 @@ static int write_buf(Uint32 *s, int n) /* The basic procedure for outputting one character. */ static int outc(int c) { - return (int)putc(c, ttysl_out); + putcbuf->orig_bytes[putcpos++] = c; + if (putcpos == putclen) { + driver_enq_bin(ttysl_port,putcbuf,0,putclen); + putcpos = 0; + putclen = TTY_BUFFSIZE; + putcbuf = driver_alloc_binary(BUFSIZ); + } + return 1; } static int move_cursor(int from, int to) @@ -1318,11 +1458,11 @@ static RETSIGTYPE suspend(int sig) exit(1); } - sys_sigset(sig, SIG_DFL); /* Set signal handler to default */ + sys_signal(sig, SIG_DFL); /* Set signal handler to default */ sys_sigrelease(sig); /* Allow 'sig' to come through */ kill(getpid(), sig); /* Send ourselves the signal */ sys_sigblock(sig); /* Reset to old mask */ - sys_sigset(sig, suspend); /* Reset signal handler */ + sys_signal(sig, suspend); /* Reset signal handler */ if (tty_set(ttysl_fd) < 0) { fprintf(stderr,"Can't set tty raw \n"); diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 502cb58dfa..851c336a11 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -46,6 +46,7 @@ static int rows; /* Number of rows available. */ #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 @@ -458,6 +459,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun switch (buf[0]) { case OP_PUTC: + case OP_PUTC_SYNC: DEBUGLOG(("OP: Putc(%I64u)",(unsigned long long)count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) return; @@ -481,6 +483,20 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } + + if (buf[0] == OP_PUTC_SYNC) { + /* On windows we do a blocking write to the tty so we just + send the ack immidiately. If at some point in the future + someone has a problem with tty output being blocking + this has to be changed. */ + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } return; } diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c index b5dff06987..63646825b2 100644 --- a/erts/emulator/hipe/hipe_amd64.c +++ b/erts/emulator/hipe/hipe_amd64.c @@ -125,7 +125,7 @@ static void atexit_alloc_code_stats(void) #define MAP_ANONYMOUS MAP_ANON #endif -static void morecore(unsigned int alloc_bytes) +static int morecore(unsigned int alloc_bytes) { unsigned int map_bytes; char *map_hint, *map_start; @@ -174,10 +174,9 @@ static void morecore(unsigned int alloc_bytes) abort(); } #endif - if (map_start == MAP_FAILED) { - perror("mmap"); - abort(); - } + if (map_start == MAP_FAILED) + return -1; + ALLOC_CODE_STATS(total_mapped += map_bytes); /* Merge adjacent mappings, so the trailing portion of the previous @@ -197,6 +196,8 @@ static void morecore(unsigned int alloc_bytes) } ALLOC_CODE_STATS(atexit_alloc_code_stats()); + + return 0; } static void *alloc_code(unsigned int alloc_bytes) @@ -206,8 +207,8 @@ static void *alloc_code(unsigned int alloc_bytes) /* Align function entries. */ alloc_bytes = (alloc_bytes + 3) & ~3; - if (code_bytes < alloc_bytes) - morecore(alloc_bytes); + if (code_bytes < alloc_bytes && morecore(alloc_bytes) != 0) + return NULL; ALLOC_CODE_STATS(++nr_allocs); ALLOC_CODE_STATS(total_alloc += alloc_bytes); res = code_next; @@ -224,18 +225,18 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +/* Make stub for native code calling exported beam function. +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl + * movq $Address, P_CALLEE_EXP(%ebp) %% Actually two movl * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -248,49 +249,51 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 23, 26, 29, or 32 bytes */ 23 + /* 23 when all offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + - ((P_BEAM_IP + 4) >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + + ((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); + if (!code) + return NULL; - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $callee_exp, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned long)beamAddress ) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned long)callee_exp ) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 24) & 0xFF; codep += 4; - /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */ + /* movl (shl 32 $callee_exp), P_CALLEE_EXP+4(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP+4 >= 128 +#if P_CALLEE_EXP+4 >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = (P_BEAM_IP+4) & 0xFF; - codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF; - codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF; - codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF; + codep[2] = (P_CALLEE_EXP+4) & 0xFF; + codep[3] = ((P_CALLEE_EXP+4) >> 8) & 0xFF; + codep[4] = ((P_CALLEE_EXP+4) >> 16) & 0xFF; + codep[5] = ((P_CALLEE_EXP+4) >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = (P_BEAM_IP+4); + codep[2] = (P_CALLEE_EXP+4); codep += 3; #endif - codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF; + codep[0] = ((unsigned long)callee_exp >> 32) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 40) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 48) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 56) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ 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 7c81040b8b..ca55d5bf3b 100644 --- a/erts/emulator/hipe/hipe_amd64_asm.m4 +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -33,7 +33,35 @@ define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define AMD64_LEAF_WORDS 'LEAF_WORDS -`#define LEAF_WORDS 'LEAF_WORDS +`#define LEAF_WORDS 'LEAF_WORDS +`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER +`#if AMD64_HP_IN_REGISTER' +`#define AMD64_HEAP_POINTER 15' +define(HP,%r15)dnl Only change this together with above +`#endif' + +`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER +`#if AMD64_FCALLS_IN_REGISTER' +`#define AMD64_FCALLS_REGISTER 11' +define(FCALLS,%r11)dnl This goes together with line above +`#endif' + +`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER +`#if AMD64_HEAP_LIMIT_IN_REGISTER' +`#define AMD64_HEAP_LIMIT_REGISTER 12' +define(HEAP_LIMIT,%r12)dnl Change this together with line above +`#endif' + +`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Workarounds for Darwin. @@ -63,33 +91,24 @@ ifelse(OPSYS,darwin,`` */ `#define P %rbp' -`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER `#if AMD64_HP_IN_REGISTER -#define AMD64_HEAP_POINTER 15' -define(HP,%r15)dnl Only change this together with above -`#define SAVE_HP movq 'HP`, P_HP(P) +#define SAVE_HP movq 'HP`, P_HP(P) #define RESTORE_HP movq P_HP(P), 'HP` #else #define SAVE_HP /*empty*/ #define RESTORE_HP /*empty*/ #endif' -`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER `#if AMD64_FCALLS_IN_REGISTER -#define AMD64_FCALLS_REGISTER 11' -define(FCALLS,%r11)dnl This goes together with line above -`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) +#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) #define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS` #else #define SAVE_FCALLS /*empty*/ #define RESTORE_FCALLS /*empty*/ #endif' -`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER `#if AMD64_HEAP_LIMIT_IN_REGISTER -#define AMD64_HEAP_LIMIT_REGISTER 12' -define(HEAP_LIMIT,%r12)dnl Change this together with line above -`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` +#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` #else #define RESTORE_HEAP_LIMIT /*empty*/ #endif' @@ -99,7 +118,6 @@ define(NSP,%rsp)dnl `#define SAVE_CSP movq %rsp, P_CSP(P) #define RESTORE_CSP movq P_CSP(P), %rsp' -`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -132,8 +150,6 @@ define(NSP,%rsp)dnl /* * Argument (parameter) registers. */ -`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -237,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)` */' @@ -261,6 +281,9 @@ 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 */' + `#endif /* HIPE_AMD64_ASM_H */' diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index a3219c7586..74cb9112ce 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -18,7 +18,7 @@ changecom(`/*', `*/')dnl * %CopyrightEnd% */ - +#`define ASM' include(`hipe/hipe_amd64_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -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 8816906870..3cb0a2875b 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_amd64_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -109,7 +108,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movq $<f's BEAM code address>, P_BEAM_IP(P) + * movq $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -119,7 +118,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* @@ -322,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 @@ -337,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: @@ -360,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 @@ -375,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_arch.h b/erts/emulator/hipe/hipe_arch.h index 04ed980126..b45209b3f7 100644 --- a/erts/emulator/hipe/hipe_arch.h +++ b/erts/emulator/hipe/hipe_arch.h @@ -29,6 +29,7 @@ extern void hipe_patch_load_fe(Uint *address, Uint value); extern int hipe_patch_insn(void *address, Uint value, Eterm type); extern int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline); +extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); extern void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity); #if defined(__sparc__) diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c index 3db3ffe9b1..c0c6305c68 100644 --- a/erts/emulator/hipe/hipe_arm.c +++ b/erts/emulator/hipe/hipe_arm.c @@ -260,9 +260,9 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +/* Make stub for native code calling exported beam function +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int *tramp_callemu; @@ -272,9 +272,9 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) * Native code calls BEAM via a stub looking as follows: * * mov r0, #beamArity - * ldr r8, [pc,#0] // beamAddress + * ldr r8, [pc,#0] // callee_exp * b nbif_callemu - * .long beamAddress + * .long callee_exp * * I'm using r0 and r8 since they aren't used for * parameter passing in native code. The branch to @@ -283,6 +283,8 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) */ code = alloc_stub(4, &tramp_callemu); + if (!code) + return NULL; callemu_offset = ((int)&nbif_callemu - ((int)&code[2] + 8)) >> 2; if (!(callemu_offset >= -0x00800000 && callemu_offset <= 0x007FFFFF)) { callemu_offset = ((int)tramp_callemu - ((int)&code[2] + 8)) >> 2; @@ -292,12 +294,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) /* mov r0, #beamArity */ code[0] = 0xE3A00000 | (beamArity & 0xFF); - /* ldr r8, [pc,#0] // beamAddress */ + /* ldr r8, [pc,#0] // callee_exp */ code[1] = 0xE59F8000; /* b nbif_callemu */ code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF); - /* .long beamAddress */ - code[3] = (unsigned int)beamAddress; + /* .long callee_exp */ + code[3] = (unsigned int)callee_exp; hipe_flush_icache_range(code, 4*sizeof(int)); diff --git a/erts/emulator/hipe/hipe_arm.h b/erts/emulator/hipe/hipe_arm.h index 19f2a986cf..b9cd1a750c 100644 --- a/erts/emulator/hipe/hipe_arm.h +++ b/erts/emulator/hipe/hipe_arm.h @@ -40,8 +40,4 @@ static __inline__ int hipe_word32_address_ok(void *address) extern void hipe_arm_inc_stack(void); -/* for hipe_bifs_enter_code_2 */ -extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); -#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) - #endif /* HIPE_ARM_H */ diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 index 85dc84973d..ca6aef2f8d 100644 --- a/erts/emulator/hipe/hipe_arm_asm.m4 +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive `#define ARM_LEAF_WORDS 'LEAF_WORDS +`#define ARM_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -77,8 +85,6 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define ARM_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -157,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)` */' @@ -180,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 @@ -195,4 +206,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_ARM_ASM_H */' diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 3ca9a1bcdb..6abc7545e0 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_arm_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -41,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, @@ -133,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 5723afac12..edcabfd7a4 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_arm_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -141,7 +140,7 @@ hipe_arm_throw_to_native: * which should look as follows: * * stub for f/N: - * <set r8 to f's BEAM code address> + * <set r8 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -150,10 +149,10 @@ hipe_arm_throw_to_native: .global nbif_callemu .type nbif_callemu, %function nbif_callemu: - str r8, [P, #P_BEAM_IP] + str r8, [P, #P_CALLEE_EXP] str r0, [P, #P_ARITY] STORE_ARG_REGS - mov r0, #HIPE_MODE_SWITCH_RES_CALL + mov r0, #HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* @@ -331,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] @@ -377,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 8af174170d..a4311d22e2 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -89,25 +89,6 @@ static Eterm address_to_term(const void *address, Process *p) /* * BIFs for reading and writing memory. Used internally by HiPE. */ -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1) -{ - unsigned char *address = term_to_address(BIF_ARG_1); - if (!address) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(make_small(*address)); -} -#endif - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1) -{ - Uint32 *address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(Uint_to_term(*address, BIF_P)); -} -#endif BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) { @@ -120,22 +101,6 @@ BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) BIF_RET(NIL); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2) -{ - Sint32 *address; - Sint value; - - address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - if (!term_to_Sint32(BIF_ARG_2, &value)) - BIF_ERROR(BIF_P, BADARG); - *address = value; - BIF_RET(NIL); -} -#endif - BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2) { Uint32 *address; @@ -432,15 +397,17 @@ BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2) ASSERT(bitoffs == 0); ASSERT(bitsize == 0); trampolines = NIL; -#ifdef HIPE_ALLOC_CODE - address = HIPE_ALLOC_CODE(nrbytes, BIF_ARG_2, &trampolines, BIF_P); - if (!address) - BIF_ERROR(BIF_P, BADARG); -#else - if (is_not_nil(BIF_ARG_2)) - BIF_ERROR(BIF_P, BADARG); - address = erts_alloc(ERTS_ALC_T_HIPE, nrbytes); -#endif + address = hipe_alloc_code(nrbytes, BIF_ARG_2, &trampolines, BIF_P); + if (!address) { + Uint nrcallees; + + if (is_tuple(BIF_ARG_2)) + nrcallees = arityval(tuple_val(BIF_ARG_2)[0]); + else + nrcallees = 0; + erl_exit(1, "%s: failed to allocate %lu bytes and %lu trampolines\r\n", + __func__, (unsigned long)nrbytes, (unsigned long)nrcallees); + } memcpy(address, bytes, nrbytes); hipe_flush_icache_range(address, nrbytes); hp = HAlloc(BIF_P, 3); @@ -639,33 +606,6 @@ BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1) BIF_RET(address_to_term(pc, BIF_P)); } -static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote) -{ - void *address = NULL; - if (!is_remote) - address = hipe_find_emu_address(m, f, arity); - if (!address) { - /* if not found, stub it via the export entry */ - /* no lock needed around erts_export_get_or_make_stub() */ - Export *export_entry = erts_export_get_or_make_stub(m, f, arity); - address = export_entry->addressv[erts_active_code_ix()]; - } - return address; -} - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1) -{ - struct mfa mfa; - void *address; - - if (!term_to_mfa(BIF_ARG_1, &mfa)) - BIF_ERROR(BIF_P, BADARG); - address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) { Eterm *pc; @@ -713,33 +653,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) BIF_RET(am_false); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_address_to_fun(Address) - * - Address is the address of the start of a emu function's code - * - returns {Module, Function, Arity} - */ -BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1) -{ - Eterm *pc; - Eterm *funcinfo; - Eterm *hp; - - pc = term_to_address(BIF_ARG_1); - if (!pc) - BIF_ERROR(BIF_P, BADARG); - funcinfo = find_function_from_pc(pc); - if (!funcinfo) - BIF_RET(am_false); - hp = HAlloc(BIF_P, 4); - hp[0] = make_arityval(3); - hp[1] = funcinfo[0]; - hp[2] = funcinfo[1]; - hp[3] = make_small(funcinfo[2]); - BIF_RET(make_tuple(hp)); -} -#endif - BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1) { struct sdesc *sdesc; @@ -948,37 +861,6 @@ BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1) BIF_RET(address_to_term(primop->address, BIF_P)); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_gbif_address(F,A) -> address or false - */ -#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void); -#include "hipe_gbif_list.h" -#undef GBIF_LIST - -BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2) -{ - Uint arity; - void *address; - - if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2)) - BIF_RET(am_false); /* error or false, does it matter? */ - arity = signed_val(BIF_ARG_2); - /* XXX: replace with a hash table later */ - do { /* trick to let us use 'break' instead of 'goto' */ -#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; } -#include "hipe_gbif_list.h" -#undef GBIF_LIST - printf("\r\n%s: guard BIF ", __FUNCTION__); - fflush(stdout); - erts_printf("%T", BIF_ARG_1); - printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity); - BIF_RET(am_false); - } while (0); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1) { if (is_not_atom(BIF_ARG_1)) @@ -1028,77 +910,13 @@ void hipe_emulate_fpe(Process* p) } #endif -#if 0 /* XXX: unused */ -/* - * At least parts of this should be inlined in native code. - * The rest could be made a primop used by both the emulator and - * native code... - */ -BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3) +void hipe_emasculate_binary(Eterm bin) { - Eterm free_vars; - Eterm mod; - Eterm *tp; - Uint index; - Uint uniq; - Uint num_free; - Eterm tmp_var; - Uint *tmp_ptr; - unsigned needed; - ErlFunThing *funp; - Eterm *hp; - int i; - - if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - free_vars = BIF_ARG_1; - - if (is_not_atom(BIF_ARG_2)) - BIF_ERROR(BIF_P, BADARG); - mod = BIF_ARG_2; - - if (is_not_tuple(BIF_ARG_3) || - (arityval(*tuple_val(BIF_ARG_3)) != 3)) - BIF_ERROR(BIF_P, BADARG); - tp = tuple_val(BIF_ARG_3); - - if (term_to_Uint(tp[1], &index) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[2], &uniq) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[3], &num_free) == 0) - BIF_ERROR(BIF_P, BADARG); - - needed = ERL_FUN_SIZE + num_free; - funp = (ErlFunThing *) HAlloc(BIF_P, needed); - hp = funp->env; - - funp->thing_word = HEADER_FUN; - - /* Need a ErlFunEntry *fe - * fe->refc++; - * funp->fe = fe; - */ - - funp->num_free = num_free; - funp->creator = BIF_P->id; - for (i = 0; i < num_free; i++) { - if (is_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - tmp_ptr = list_val(free_vars); - tmp_var = CAR(tmp_ptr); - free_vars = CDR(tmp_ptr); - *hp++ = tmp_var; - } - if (is_not_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - - funp->next = MSO(BIF_P).funs; - MSO(BIF_P).funs = funp; - - BIF_RET(make_fun(funp)); + ProcBin* pb = (ProcBin *) boxed_val(bin); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + ASSERT(pb->flags != 0); + erts_emasculate_writable_binary(pb); } -#endif /* * args: Module, {Uniq, Index, BeamAddress} @@ -1163,22 +981,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) BIF_RET(am_true); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2) -{ - void *beamAddress; - Uint beamArity; - void *stubAddress; - - if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 || - is_not_small(BIF_ARG_2) || - (beamArity = unsigned_val(BIF_ARG_2)) >= 256) - BIF_ERROR(BIF_P, BADARG); - stubAddress = hipe_make_native_stub(beamAddress, beamArity); - BIF_RET(address_to_term(stubAddress, BIF_P)); -} -#endif - /* * MFA info hash table: * - maps MFA to native code entry point @@ -1500,18 +1302,15 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote) { - void *BEAMAddress; + Export *export_entry; void *StubAddress; -#if 0 - if (is_not_atom(m) || is_not_atom(f) || arity > 255) - return NULL; -#endif - BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote); - StubAddress = hipe_make_native_stub(BEAMAddress, arity); -#if 0 - hipe_mfa_set_na(m, f, arity, StubAddress); -#endif + ASSERT(is_remote); + + export_entry = erts_export_get_or_make_stub(m, f, arity); + StubAddress = hipe_make_native_stub(export_entry, arity); + if (!StubAddress) + erl_exit(1, "hipe_make_stub: code allocation failed\r\n"); return StubAddress; } @@ -1946,13 +1745,11 @@ BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1) BIF_RET(am_false); } -BIF_RETTYPE hipe_bifs_system_crc_1(BIF_ALIST_1) +BIF_RETTYPE hipe_bifs_system_crc_0(BIF_ALIST_0) { Uint crc; - if (!term_to_Uint(BIF_ARG_1, &crc)) - BIF_ERROR(BIF_P, BADARG); - crc ^= (HIPE_SYSTEM_CRC ^ HIPE_LITERALS_CRC); + crc = HIPE_SYSTEM_CRC; BIF_RET(Uint_to_term(crc, BIF_P)); } diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index 2514b1c3a5..4271a78de3 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -49,7 +49,6 @@ bif hipe_bifs:constants_size/0 bif hipe_bifs:merge_term/1 bif hipe_bifs:fun_to_address/1 -#bif hipe_bifs:get_emu_address/1 bif hipe_bifs:set_native_address/3 #bif hipe_bifs:address_to_fun/1 @@ -72,11 +71,10 @@ bif hipe_bifs:term_to_word/1 bif hipe_bifs:get_fe/2 bif hipe_bifs:set_native_address_in_fe/2 -#bif hipe_bifs:make_native_stub/2 bif hipe_bifs:find_na_or_make_stub/2 bif hipe_bifs:check_crc/1 -bif hipe_bifs:system_crc/1 +bif hipe_bifs:system_crc/0 bif hipe_bifs:get_rts_param/1 #bif hipe_bifs:tuple_to_float/1 @@ -142,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_bif1.c b/erts/emulator/hipe/hipe_bif1.c index 56767ef04b..ecb34df412 100644 --- a/erts/emulator/hipe/hipe_bif1.c +++ b/erts/emulator/hipe/hipe_bif1.c @@ -574,22 +574,6 @@ BIF_RETTYPE hipe_bifs_pause_times_0(BIF_ALIST_0) /* XXX: these macros have free variables */ #ifdef BM_TIMERS -#if USE_PERFCTR -#define MAKE_TIME(_timer_) { \ - BM_TIMER_T tmp = _timer_##_time; \ - milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ - tmp /= 1000; \ - sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \ - min = (uint)tmp / 60; } - -#define MAKE_MICRO_TIME(_timer_) { \ - BM_TIMER_T tmp = _timer_##_time * 1000; \ - micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ - tmp /= 1000; \ - milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ - sec = (uint)tmp / 1000; } - -#else #define MAKE_TIME(_timer_) { \ BM_TIMER_T tmp = _timer_##_time / 1000000; \ milli = tmp % 1000; \ @@ -604,7 +588,6 @@ BIF_RETTYPE hipe_bifs_pause_times_0(BIF_ALIST_0) milli = tmp % 1000; \ sec = tmp / 1000; } -#endif #else #define MAKE_TIME(_timer_) #define MAKE_MICRO_TIME(_timer_) @@ -852,9 +835,6 @@ BIF_RETTYPE hipe_bifs_misc_timer_clear_0(BIF_ALIST_0) /* * HiPE hrvtime(). * These implementations are currently available: - * + On Linux with the perfctr extension we can use the process' - * virtualised time-stamp counter. To enable this mode you must - * pass `--with-perfctr=/path/to/perfctr' when configuring. * + The fallback, which is the same as {X,_} = runtime(statistics). */ @@ -866,37 +846,6 @@ static double fallback_get_hrvtime(void) return (double)ms_user; } -#if USE_PERFCTR - -#include "hipe_perfctr.h" -static int hrvtime_started; /* 0: closed, +1: perfctr, -1: fallback */ -#define hrvtime_is_started() (hrvtime_started != 0) - -static void start_hrvtime(void) -{ - if (hipe_perfctr_hrvtime_open() >= 0) - hrvtime_started = 1; - else - hrvtime_started = -1; -} - -static void stop_hrvtime(void) -{ - if (hrvtime_started > 0) - hipe_perfctr_hrvtime_close(); - hrvtime_started = 0; -} - -static double get_hrvtime(void) -{ - if (hrvtime_started > 0) - return hipe_perfctr_hrvtime_get(); - else - return fallback_get_hrvtime(); -} - -#else /* !USE_PERFCTR */ - /* * Fallback, if nothing better exists. * This is the same as {X,_} = statistics(runtime), which uses @@ -908,8 +857,6 @@ static double get_hrvtime(void) #define stop_hrvtime() do{}while(0) #define get_hrvtime() fallback_get_hrvtime() -#endif /* !USE_PERFCTR */ - BIF_RETTYPE hipe_bifs_get_hrvtime_0(BIF_ALIST_0) { Eterm *hp; diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 5f92b6bac4..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 */ @@ -277,7 +279,10 @@ ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1, ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1, ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1, ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1, -$1)))))))))))') +ifelse($1,send_2,hipe_wrapper_send_2, +ifelse($1,send_3,hipe_wrapper_send_3, +ifelse($1,ebif_bang_2,hipe_wrapper_ebif_bang_2, +$1))))))))))))))') define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))') include(TARGET/`erl_bif_list.h') diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 32694a8f97..2804d46249 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -172,8 +172,10 @@ void hipe_print_pcb(Process *p) printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p); printf("-----------------------------------------------\r\n"); printf("Offset| Name | Value | *Value |\r\n"); +#undef U #define U(n,x) \ printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x) +#undef P #define P(n,x) \ printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL) @@ -211,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); @@ -231,7 +233,7 @@ void hipe_print_pcb(Process *p) U("nsp ", hipe.nsp); U("nstack ", hipe.nstack); U("nstend ", hipe.nstend); - U("ncallee ", hipe.ncallee); + U("ncallee ", hipe.u.ncallee); hipe_arch_print_pcb(&p->hipe); #endif /* HIPE */ #undef U diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 86c4068072..b10263f6e2 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -22,6 +22,9 @@ #ifdef HAVE_CONFIG_H #include "config.h" #endif + +#define ERL_WANT_GC_INTERNALS__ + #include "global.h" #include "erl_gc.h" diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 0e287908b1..49e8d39360 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -498,8 +498,8 @@ static const struct rts_param rts_params[] = { { 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) }, { 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) }, { 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) }, - { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) }, - { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) }, + { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.u.ncallee) }, + { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.u.closure) }, { 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) }, { 44, "P_CSP", #if defined(__i386__) || defined(__x86_64__) @@ -524,6 +524,7 @@ static const struct rts_param rts_params[] = { }, { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) }, { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) }, + { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) }, }; #define NR_PARAMS ARRAY_SIZE(rts_params) @@ -647,8 +648,7 @@ static int do_e(FILE *fp, const char* this_exe) fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc); } else { - fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", - literals_crc); + fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc()).\n"); } return 0; } diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 1ae1d17b7f..8c73312d45 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -140,7 +140,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line) #endif /* HIPE_DEBUG > 0 */ /* ensure that at least nwords words are available on the native stack */ -static void hipe_check_nstack(Process *p, unsigned nwords); #if defined(__sparc__) #include "hipe_sparc_glue.h" @@ -159,7 +158,7 @@ static void hipe_check_nstack(Process *p, unsigned nwords); Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */ -static Eterm hipe_beam_catch_throw; +Eterm hipe_beam_catch_throw; void hipe_mode_switch_init(void) { @@ -185,22 +184,6 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure) bfun[-4] = (Uint)nfun; } -void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) -{ - if (!hipe_bifcall_from_native_is_recursive(p)) - return; - - /* ensure that at least 2 words are available on the BEAM stack */ - if ((p->stop - 2) < p->htop) { - DPRINTF("calling gc to reserve BEAM stack size"); - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); - ASSERT(!((p->stop - 2) < p->htop)); - } - p->stop -= 2; - p->stop[0] = NIL; - p->stop[1] = hipe_beam_catch_throw; -} - static __inline__ void hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) { @@ -223,15 +206,6 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) p->cp = hipe_beam_pc_return; } -void hipe_unreserve_beam_trap_frame(Process *p) -{ - if (!hipe_bifcall_from_native_is_recursive(p)) - return; - - ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw); - p->stop += 2; -} - static __inline__ void hipe_pop_beam_trap_frame(Process *p) { ASSERT(p->stop[1] == hipe_beam_catch_throw); @@ -265,14 +239,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) /* BEAM calls a native code function */ unsigned arity = cmd >> 8; - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -290,18 +264,18 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) arity -= funp->num_free; /* arity == #formals */ reg[arity] = fun; ++arity; /* correct for having added the closure */ - /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */ + /* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */ /* just like a normal call from now on */ - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -404,13 +378,13 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) if (is_recursive) hipe_push_beam_trap_frame(p, reg, p->arity); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; break; } - case HIPE_MODE_SWITCH_RES_CALL: { + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: { /* Native code calls or tailcalls BEAM. * - * p->i is the callee's BEAM code + * p->hipe.u.callee_exp is the callee's export entry * p->arity is the callee's arity * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters @@ -430,15 +404,15 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * F(A1, ..., AN, FV1, ..., FVM, Closure) * (Where Ai is argument i and FVj is free variable j) * - * p->hipe.closure contains the closure + * p->hipe.u.closure contains the closure * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters */ ErlFunThing *closure; unsigned num_free, arity, i, is_recursive; - HIPE_ASSERT(is_fun(p->hipe.closure)); - closure = (ErlFunThing*)fun_val(p->hipe.closure); + HIPE_ASSERT(is_fun(p->hipe.u.closure)); + closure = (ErlFunThing*)fun_val(p->hipe.u.closure); num_free = closure->num_free; arity = closure->fe->arity; @@ -468,10 +442,10 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p->i = closure->fe->address; /* Change result code to the faster plain CALL type. */ - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; } /* Append the closure as the last parameter. Don't increment arity. */ - reg[arity] = p->hipe.closure; + reg[arity] = p->hipe.u.closure; if (is_recursive) { /* BEAM called native, which now calls BEAM. @@ -549,7 +523,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) } } HIPE_CHECK_PCB(p); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; p->def_arg_reg[3] = result; return p; } @@ -577,7 +551,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) address = hipe_get_remote_na(mfa[0], mfa[1], arity); if (!address) goto do_apply_fail; - p->hipe.ncallee = (void(*)(void)) address; + p->hipe.u.ncallee = (void(*)(void)) address; result = hipe_tailcall_to_native(p, arity, reg); goto do_return_from_native; do_apply_fail: @@ -607,7 +581,6 @@ static unsigned hipe_next_nstack_size(unsigned size) } #if 0 && defined(HIPE_NSTACK_GROWS_UP) -#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) void hipe_inc_nstack(Process *p) { Eterm *old_nstack = p->hipe.nstack; @@ -631,7 +604,6 @@ void hipe_inc_nstack(Process *p) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) -#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) void hipe_inc_nstack(Process *p) { unsigned old_size = p->hipe.nstend - p->hipe.nstack; @@ -663,12 +635,6 @@ void hipe_empty_nstack(Process *p) p->hipe.nstend = NULL; } -static void hipe_check_nstack(Process *p, unsigned nwords) -{ - while (hipe_nstack_avail(p) < nwords) - hipe_inc_nstack(p); -} - void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free) { unsigned arity; diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index 06721e3c04..b8de12fcbb 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -31,7 +31,7 @@ /* result codes for beam_emu <- hipe_mode_switch() return */ #define HIPE_MODE_SWITCH_RES_RETURN 4 -#define HIPE_MODE_SWITCH_RES_CALL 5 +#define HIPE_MODE_SWITCH_RES_CALL_EXPORTED 5 #define HIPE_MODE_SWITCH_RES_THROW 6 /* additional result codes for hipe_mode_switch() <- native return */ @@ -45,6 +45,8 @@ #define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */ +#define HIPE_MODE_SWITCH_RES_CALL_BEAM 14 + #ifndef ASM #include "error.h" @@ -59,13 +61,58 @@ void hipe_empty_nstack(Process *p); void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); -void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); -void hipe_unreserve_beam_trap_frame(Process*); +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process*); extern Uint hipe_beam_pc_return[]; extern Uint hipe_beam_pc_throw[]; extern Uint hipe_beam_pc_resume[]; +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#include "erl_gc.h" +#include "hipe_stack.h" + +#if defined(__sparc__) +#include "hipe_sparc_glue.h" +#elif defined(__i386__) +#include "hipe_x86_glue.h" +#elif defined(__x86_64__) +#include "hipe_amd64_glue.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_glue.h" +#elif defined(__arm__) +#include "hipe_arm_glue.h" +#endif + +extern Eterm hipe_beam_catch_throw; + +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + /* ensure that at least 2 words are available on the BEAM stack */ + if ((p->stop - 2) < p->htop) { + p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + ASSERT(!((p->stop - 2) < p->htop)); + } + p->stop -= 2; + p->stop[0] = NIL; + p->stop[1] = hipe_beam_catch_throw; +} + +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process *p) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw); + p->stop += 2; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #endif /* ASM */ #endif /* HIPE_MODE_SWITCH_H */ diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 7d343dd91e..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); } @@ -330,8 +324,6 @@ char *hipe_bs_allocate(int len) Binary *bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_smp_atomic_init_nob(&bptr->refc, 1); return bptr->orig_bytes; } @@ -341,7 +333,6 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize) Binary *bptr; bptr = erts_bin_realloc(oldbptr, newsize); - bptr->orig_size = newsize; return bptr; } 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_perfctr.c b/erts/emulator/hipe/hipe_perfctr.c deleted file mode 100644 index 371b3fb097..0000000000 --- a/erts/emulator/hipe/hipe_perfctr.c +++ /dev/null @@ -1,229 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif -#include "sys.h" -#include "error.h" -#include "global.h" -#include "bif.h" -#include "big.h" -#include "erl_binary.h" -#include "hipe_perfctr.h" -#include "libperfctr.h" - -static struct vperfctr *vperfctr; -static unsigned int have_rdtsc; -static double tsc_to_ms; -static unsigned int tsc_on; /* control calls must set tsc_on if have_rdtsc is true */ -static unsigned int nractrs; -static unsigned int users; -#define USER_BIFS (1<<0) -#define USER_HRVTIME (1<<1) - -static int hipe_perfctr_open(unsigned int user) -{ - struct perfctr_info info; - - if (!vperfctr) { - vperfctr = vperfctr_open(); - if (!vperfctr) - return -1; - if (vperfctr_info(vperfctr, &info) >= 0) { - tsc_to_ms = (double)(info.tsc_to_cpu_mult ? : 1) / (double)info.cpu_khz; - have_rdtsc = (info.cpu_features & PERFCTR_FEATURE_RDTSC) ? 1 : 0; - } - tsc_on = 0; - nractrs = 0; - } - users |= user; - return 0; -} - -static void hipe_perfctr_reset(void) -{ - struct vperfctr_control control; - - memset(&control, 0, sizeof control); - if (have_rdtsc) - control.cpu_control.tsc_on = 1; - nractrs = 0; - if (vperfctr_control(vperfctr, &control) >= 0) - tsc_on = 1; -} - -static void hipe_perfctr_close(unsigned int user) -{ - if (!vperfctr) - return; - users &= ~user; - switch (users) { - case 0: - vperfctr_unlink(vperfctr); - vperfctr_close(vperfctr); - vperfctr = NULL; - tsc_on = 0; - nractrs = 0; - break; - case USER_HRVTIME: - hipe_perfctr_reset(); - } -} - -/* - * Interface for HiPE's hrvtime code. - */ - -int hipe_perfctr_hrvtime_open(void) -{ - if (hipe_perfctr_open(USER_HRVTIME) < 0) - return -1; - if (have_rdtsc) { - if (!tsc_on) - hipe_perfctr_reset(); /* note: updates tsc_on */ - if (tsc_on) - return 0; - } - hipe_perfctr_hrvtime_close(); - return -1; -} - -void hipe_perfctr_hrvtime_close(void) -{ - hipe_perfctr_close(USER_HRVTIME); -} - -double hipe_perfctr_hrvtime_get(void) -{ - return (double)vperfctr_read_tsc(vperfctr) * tsc_to_ms; -} - -/* - * BIF interface for user-programmable performance counters. - */ - -BIF_RETTYPE hipe_bifs_vperfctr_open_0(BIF_ALIST_0) -{ - if (hipe_perfctr_open(USER_BIFS) < 0) - BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ - BIF_RET(am_true); -} - -BIF_RETTYPE hipe_bifs_vperfctr_close_0(BIF_ALIST_0) -{ - hipe_perfctr_close(USER_BIFS); - BIF_RET(NIL); -} - -static Eterm ull_to_integer(unsigned long long x, Process *p) -{ - unsigned long long tmpx; - unsigned int ds, i; - size_t sz; - Eterm *hp; - ErtsDigit *xp; - - if (x <= (unsigned long long)MAX_SMALL) - return make_small(x); - - /* Calculate number of digits. */ - ds = 0; - tmpx = x; - do { - ++ds; - tmpx = (tmpx >> (D_EXP / 2)) >> (D_EXP / 2); - } while (tmpx != 0); - - sz = BIG_NEED_SIZE(ds); /* number of words including arity */ - hp = HAlloc(p, sz); - *hp = make_pos_bignum_header(sz-1); - - xp = (ErtsDigit*)(hp+1); - i = 0; - do { - xp[i++] = (ErtsDigit)x; - x = (x >> (D_EXP / 2)) >> (D_EXP / 2); - } while (i < ds); - while (i & (BIG_DIGITS_PER_WORD-1)) - xp[i++] = 0; - - return make_big(hp); -} - -BIF_RETTYPE hipe_bifs_vperfctr_info_0(BIF_ALIST_0) -{ - struct perfctr_info info; - - if (!vperfctr || vperfctr_info(vperfctr, &info) < 0) - BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ - BIF_RET(new_binary(BIF_P, (void*)&info, sizeof info)); -} - -BIF_RETTYPE hipe_bifs_vperfctr_read_tsc_0(BIF_ALIST_0) -{ - unsigned long long val; - - if (!vperfctr || !tsc_on) - BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ - val = vperfctr_read_tsc(vperfctr); - BIF_RET(ull_to_integer(val, BIF_P)); -} - -BIF_RETTYPE hipe_bifs_vperfctr_read_pmc_1(BIF_ALIST_1) -{ - Uint pmc; - unsigned long long val; - - if (!vperfctr || - is_not_small(BIF_ARG_1) || - (pmc = unsigned_val(BIF_ARG_1), pmc >= nractrs)) - BIF_RET(am_false); /* for consistency with the arity 0 BIFs */ - val = vperfctr_read_pmc(vperfctr, pmc); - BIF_RET(ull_to_integer(val, BIF_P)); -} - -BIF_RETTYPE hipe_bifs_vperfctr_control_1(BIF_ALIST_1) -{ - void *bytes; - struct vperfctr_control control; - Uint bitoffs; - Uint bitsize; - - if (!vperfctr) - BIF_ERROR(BIF_P, BADARG); - if (is_not_binary(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - if (binary_size(BIF_ARG_1) != sizeof control) - BIF_ERROR(BIF_P, BADARG); - ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); - ASSERT(bitoffs == 0); - ASSERT(bitsize == 0); - memcpy(&control, bytes, sizeof control); - if (have_rdtsc) - control.cpu_control.tsc_on = 1; - if (vperfctr_control(vperfctr, &control) < 0) { - hipe_perfctr_reset(); - BIF_ERROR(BIF_P, BADARG); - } - tsc_on = control.cpu_control.tsc_on; - nractrs = control.cpu_control.nractrs; - BIF_RET(NIL); -} diff --git a/erts/emulator/hipe/hipe_perfctr.h b/erts/emulator/hipe/hipe_perfctr.h deleted file mode 100644 index 8fbf9ecf35..0000000000 --- a/erts/emulator/hipe/hipe_perfctr.h +++ /dev/null @@ -1,23 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - - -extern int hipe_perfctr_hrvtime_open(void); -extern void hipe_perfctr_hrvtime_close(void); -extern double hipe_perfctr_hrvtime_get(void); diff --git a/erts/emulator/hipe/hipe_perfctr.tab b/erts/emulator/hipe/hipe_perfctr.tab deleted file mode 100644 index eaecea4651..0000000000 --- a/erts/emulator/hipe/hipe_perfctr.tab +++ /dev/null @@ -1,25 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2004-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -bif hipe_bifs:vperfctr_open/0 -bif hipe_bifs:vperfctr_close/0 -bif hipe_bifs:vperfctr_info/0 -bif hipe_bifs:vperfctr_read_tsc/0 -bif hipe_bifs:vperfctr_read_pmc/1 -bif hipe_bifs:vperfctr_control/1 diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c index 2d8fd61e1e..1eaa9f6855 100644 --- a/erts/emulator/hipe/hipe_ppc.c +++ b/erts/emulator/hipe/hipe_ppc.c @@ -285,7 +285,7 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type) } } -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; @@ -293,17 +293,19 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) abort(); code = alloc_stub(7); + if (!code) + return NULL; - /* addis r12,0,beamAddress@highest */ - code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff); - /* ori r12,r12,beamAddress@higher */ - code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff); + /* addis r12,0,callee_exp@highest */ + code[0] = 0x3d800000 | (((unsigned long)callee_exp >> 48) & 0xffff); + /* ori r12,r12,callee_exp@higher */ + code[1] = 0x618c0000 | (((unsigned long)callee_exp >> 32) & 0xffff); /* sldi r12,r12,32 (rldicr r12,r12,32,31) */ code[2] = 0x798c07c6; - /* oris r12,r12,beamAddress@h */ - code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff); - /* ori r12,r12,beamAddress@l */ - code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff); + /* oris r12,r12,callee_exp@h */ + code[3] = 0x658c0000 | (((unsigned long)callee_exp >> 16) & 0xffff); + /* ori r12,r12,callee_exp@l */ + code[4] = 0x618c0000 | ((unsigned long)callee_exp & 0xffff); /* addi r0,0,beamArity */ code[5] = 0x38000000 | (beamArity & 0x7FFF); /* ba nbif_callemu */ @@ -355,18 +357,16 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; /* * Native code calls BEAM via a stub looking as follows: * - * addi r12,0,beamAddress@l + * addi r12,0,callee_exp@l * addi r0,0,beamArity - * addis r12,r12,beamAddress@ha + * addis r12,r12,callee_exp@ha * ba nbif_callemu * * I'm using r0 and r12 since the standard SVR4 ABI allows @@ -383,13 +383,15 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) abort(); code = alloc_stub(4); + if (!code) + return NULL; - /* addi r12,0,beamAddress@l */ - code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF); + /* addi r12,0,callee_exp@l */ + code[0] = 0x39800000 | ((unsigned long)callee_exp & 0xFFFF); /* addi r0,0,beamArity */ code[1] = 0x38000000 | (beamArity & 0x7FFF); - /* addis r12,r12,beamAddress@ha */ - code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress); + /* addis r12,r12,callee_exp@ha */ + code[2] = 0x3D8C0000 | at_ha((unsigned long)callee_exp); /* ba nbif_callemu */ code[3] = 0x48000002 | (unsigned long)&nbif_callemu; diff --git a/erts/emulator/hipe/hipe_ppc.h b/erts/emulator/hipe/hipe_ppc.h index 66000c1846..e9d3e6564b 100644 --- a/erts/emulator/hipe/hipe_ppc.h +++ b/erts/emulator/hipe/hipe_ppc.h @@ -64,10 +64,6 @@ AEXTERN(void,hipe_ppc_inc_stack,(void)); extern void hipe_ppc_inc_stack(void); /* we don't have the AEXTERN() fallback :-( */ #endif -/* for hipe_bifs_enter_code_2 */ -extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); -#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) - #if !defined(__powerpc64__) extern const unsigned int fconv_constant[]; #endif diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 343402f9f0..e5a56de687 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -23,6 +23,22 @@ changecom(`/*', `*/')dnl #define HIPE_PPC_ASM_H' /* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive + +`#define PPC_LEAF_WORDS 'LEAF_WORDS +`#define PPC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + +/* * Handle 32 vs 64-bit. */ ifelse(ARCH,ppc64,` @@ -53,13 +69,6 @@ define(WSIZE,4)dnl `#define STORE 'STORE `#define CMPI 'CMPI -/* - * Tunables. - */ -define(LEAF_WORDS,16)dnl number of stack words for leaf functions -define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive - -`#define PPC_LEAF_WORDS 'LEAF_WORDS /* * Workarounds for Darwin. @@ -193,8 +202,6 @@ NAME: \ /* * Argument (parameter) registers. */ -`#define PPC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -273,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)` */' @@ -294,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 @@ -309,4 +321,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_PPC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 7cc2b5c7b6..b173b896b8 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_ppc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -45,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, @@ -143,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 6f0217c738..109289116b 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_ppc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -296,7 +295,7 @@ CSYM(hipe_ppc_throw_to_native): * which should look as follows: * * stub for f/N: - * <set r12 to f's BEAM code address> + * <set r12 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -312,10 +311,10 @@ CSYM(hipe_ppc_throw_to_native): */ GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): - STORE r12, P_BEAM_IP(P) + STORE r12, P_CALLEE_EXP(P) STORE r0, P_ARITY(P) STORE_ARG_REGS - li r3, HIPE_MODE_SWITCH_RES_CALL + li r3, HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* @@ -463,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 @@ -478,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 */ @@ -506,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_process.h b/erts/emulator/hipe/hipe_process.h index 4ee99d78a2..86655ad42c 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -23,14 +23,17 @@ #define HIPE_PROCESS_H #include "erl_alloc.h" +#include "export.h" struct hipe_process_state { Eterm *nsp; /* Native stack pointer. */ Eterm *nstack; /* Native stack block start. */ Eterm *nstend; /* Native stack block end (start+size). */ - /* XXX: ncallee and closure could share space in a union */ - void (*ncallee)(void); /* Native code callee (label) to invoke. */ - Eterm closure; /* Used to pass a closure from native code. */ + union { + void (*ncallee)(void); /* Native code callee (label) to invoke. */ + Eterm closure; /* Used to pass a closure from native code. */ + Export* callee_exp; /* Used to pass export entry from native code */ + }u; Eterm *nstgraylim; /* Gray/white stack boundary. */ Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if graylim exists. Ignored if no graylim. */ diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c index 1183856c7e..bea3a0fecd 100644 --- a/erts/emulator/hipe/hipe_risc_stack.c +++ b/erts/emulator/hipe/hipe_risc_stack.c @@ -226,7 +226,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (actuals, caller's frame, caller's return address). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -254,7 +254,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)&nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c index 49d4da7bab..fea3b623a9 100644 --- a/erts/emulator/hipe/hipe_sparc.c +++ b/erts/emulator/hipe/hipe_sparc.c @@ -130,7 +130,7 @@ static void atexit_alloc_code_stats(void) #define ALLOC_CODE_STATS(X) do{}while(0) #endif -static void morecore(unsigned int alloc_bytes) +static int morecore(unsigned int alloc_bytes) { unsigned int map_bytes; char *map_hint, *map_start; @@ -158,10 +158,9 @@ static void morecore(unsigned int alloc_bytes) #endif , -1, 0); - if (map_start == MAP_FAILED) { - perror("mmap"); - abort(); - } + if (map_start == MAP_FAILED) + return -1; + ALLOC_CODE_STATS(total_mapped += map_bytes); /* Merge adjacent mappings, so the trailing portion of the previous @@ -177,6 +176,8 @@ static void morecore(unsigned int alloc_bytes) } ALLOC_CODE_STATS(atexit_alloc_code_stats()); + + return 0; } static void *alloc_code(unsigned int alloc_bytes) @@ -186,8 +187,8 @@ static void *alloc_code(unsigned int alloc_bytes) /* Align function entries. */ alloc_bytes = (alloc_bytes + 3) & ~3; - if (code_bytes < alloc_bytes) - morecore(alloc_bytes); + if (code_bytes < alloc_bytes && morecore(alloc_bytes) != 0) + return NULL; ALLOC_CODE_STATS(++nr_allocs); ALLOC_CODE_STATS(total_alloc += alloc_bytes); res = code_next; @@ -204,22 +205,22 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int callEmuOffset; int i; code = alloc_code(5*sizeof(int)); + if (!code) + return NULL; /* sethi %hi(Address), %i4 */ - code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF); + code[0] = 0x39000000 | (((unsigned int)callee_exp >> 10) & 0x3FFFFF); /* or %g0, %o7, %i3 ! mov %o7, %i3 */ code[1] = 0xB610000F; /* or %i4, %lo(Address), %i4 */ - code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF); + code[2] = 0xB8172000 | ((unsigned int)callee_exp & 0x3FF); /* call callemu */ callEmuOffset = (char*)nbif_callemu - (char*)&code[3]; code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF); diff --git a/erts/emulator/hipe/hipe_sparc.h b/erts/emulator/hipe/hipe_sparc.h index 1134b86004..2d92ca3ca8 100644 --- a/erts/emulator/hipe/hipe_sparc.h +++ b/erts/emulator/hipe/hipe_sparc.h @@ -47,8 +47,4 @@ static __inline__ int hipe_word32_address_ok(void *address) extern void hipe_sparc_inc_stack(void); -/* for hipe_bifs_enter_code_2 */ -extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); -#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) - #endif /* HIPE_SPARC_H */ diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 index 227d10ed80..8020104e40 100644 --- a/erts/emulator/hipe/hipe_sparc_asm.m4 +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive `#define SPARC_LEAF_WORDS 'LEAF_WORDS +`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -80,9 +88,6 @@ define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' )dnl @@ -171,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)` */' @@ -195,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 @@ -210,4 +220,6 @@ define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_SPARC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index ca5af45d58..1d0ff8c16e 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_sparc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -53,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, @@ -145,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 44bdf1bc7e..094a87fd58 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_sparc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .section ".text" @@ -155,9 +154,9 @@ hipe_sparc_throw_to_native: * which should look as follows: * * stub for f/N: - * sethi %hi(f's BEAM code address), TEMP_ARG0 + * sethi %hi(f's export entry address), TEMP_ARG0 * mov RA, TEMP_RA ! because the call below clobbers RA (%o7) - * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0 + * or TEMP_ARG0, %lo(f's export entry address), TEMP_ARG0 * call nbif_callemu ! clobbers RA! * mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY * @@ -165,12 +164,12 @@ hipe_sparc_throw_to_native: */ .global nbif_callemu nbif_callemu: - st TEMP_ARG0, [P+P_BEAM_IP] + st TEMP_ARG0, [P+P_CALLEE_EXP] st TEMP_ARG1, [P+P_ARITY] st TEMP_RA, [P+P_NRA] STORE_ARG_REGS ba .flush_exit - mov HIPE_MODE_SWITCH_RES_CALL, %o0 + mov HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %o0 /* * nbif_apply @@ -317,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 */ @@ -327,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] @@ -365,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_stack.h b/erts/emulator/hipe/hipe_stack.h index 66f9f04c73..4cfdb54dd8 100644 --- a/erts/emulator/hipe/hipe_stack.h +++ b/erts/emulator/hipe/hipe_stack.h @@ -108,12 +108,23 @@ extern int hipe_fill_stacktrace(Process*, int, Eterm**); #if 0 && defined(HIPE_NSTACK_GROWS_UP) #define hipe_nstack_start(p) ((p)->hipe.nstack) #define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack) +#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) #define hipe_nstack_start(p) ((p)->hipe.nsp) #define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp) +#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) #endif +/* ensure that at least nwords words are available on the native stack */ +static __inline__ void hipe_check_nstack(Process *p, unsigned nwords) +{ + extern void hipe_inc_nstack(Process *p); + + while (hipe_nstack_avail(p) < nwords) + hipe_inc_nstack(p); +} + /* * GC support procedures */ diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c index 327c74e9aa..998905ea63 100644 --- a/erts/emulator/hipe/hipe_x86.c +++ b/erts/emulator/hipe/hipe_x86.c @@ -108,7 +108,7 @@ static void atexit_alloc_code_stats(void) #define MAP_ANONYMOUS MAP_ANON #endif -static void morecore(unsigned int alloc_bytes) +static int morecore(unsigned int alloc_bytes) { unsigned int map_bytes; char *map_hint, *map_start; @@ -136,10 +136,9 @@ static void morecore(unsigned int alloc_bytes) #endif , -1, 0); - if (map_start == MAP_FAILED) { - perror("mmap"); - abort(); - } + if (map_start == MAP_FAILED) + return -1; + ALLOC_CODE_STATS(total_mapped += map_bytes); /* Merge adjacent mappings, so the trailing portion of the previous @@ -155,6 +154,8 @@ static void morecore(unsigned int alloc_bytes) } ALLOC_CODE_STATS(atexit_alloc_code_stats()); + + return 0; } static void *alloc_code(unsigned int alloc_bytes) @@ -164,8 +165,8 @@ static void *alloc_code(unsigned int alloc_bytes) /* Align function entries. */ alloc_bytes = (alloc_bytes + 3) & ~3; - if (code_bytes < alloc_bytes) - morecore(alloc_bytes); + if (code_bytes < alloc_bytes && morecore(alloc_bytes) != 0) + return NULL; ALLOC_CODE_STATS(++nr_allocs); ALLOC_CODE_STATS(total_alloc += alloc_bytes); res = code_next; @@ -182,18 +183,16 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movl $Address, P_BEAM_IP(%ebp) + * movl $Address, P_CALLEE_EXP(%ebp) * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -206,28 +205,30 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 16, 19, or 22 bytes */ 16 + /* 16 when both offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); + if (!code) + return NULL; - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $beamAddress, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned int)beamAddress) & 0xFF; - codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned int)callee_exp) & 0xFF; + codep[1] = ((unsigned int)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned int)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned int)callee_exp >> 24) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ diff --git a/erts/emulator/hipe/hipe_x86.h b/erts/emulator/hipe/hipe_x86.h index 97f09e38cd..f29117d0c4 100644 --- a/erts/emulator/hipe/hipe_x86.h +++ b/erts/emulator/hipe/hipe_x86.h @@ -53,8 +53,4 @@ extern void nbif_inc_stack_0(void); extern void nbif_handle_fp_exception(void); #endif -/* for hipe_bifs_enter_code_2 */ -extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); -#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) - #endif /* HIPE_X86_H */ diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 index 020ccf8d4b..436feca506 100644 --- a/erts/emulator/hipe/hipe_x86_asm.m4 +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -33,6 +33,18 @@ define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define X86_LEAF_WORDS 'LEAF_WORDS `#define LEAF_WORDS 'LEAF_WORDS +`#define X86_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define X86_HP_IN_ESI 'HP_IN_ESI +`#define X86_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + /* * Workarounds for Darwin. */ @@ -60,7 +72,6 @@ ifelse(OPSYS,darwin,`` */ `#define P %ebp' -`#define X86_HP_IN_ESI 'HP_IN_ESI `#if X86_HP_IN_ESI #define SAVE_HP movl %esi, P_HP(P) #define RESTORE_HP movl P_HP(P), %esi @@ -73,7 +84,6 @@ ifelse(OPSYS,darwin,`` #define SAVE_CSP movl %esp, P_CSP(P) #define RESTORE_CSP movl P_CSP(P), %esp' -`#define X86_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -100,12 +110,10 @@ ifelse(OPSYS,darwin,`` SAVE_CACHED_STATE; \ SWITCH_ERLANG_TO_C_QUICK' + /* * Argument (parameter) registers. */ -`#define X86_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - ifelse(eval(NR_ARG_REGS >= 1),0,, ``#define ARG0 %eax '')dnl @@ -204,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 @@ -227,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)` */' @@ -266,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 @@ -282,4 +296,6 @@ define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl `#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE `#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE +`#endif /* ASM */' + `#endif /* HIPE_X86_ASM_H */' diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index dd6980f555..bf549c90e4 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_x86_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -47,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, @@ -157,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 88b86f4de7..f124e36a26 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_x86_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -104,7 +103,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movl $<f's BEAM code address>, P_BEAM_IP(P) + * movl $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -114,7 +113,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* @@ -300,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 @@ -315,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: @@ -338,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 @@ -353,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/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c index 9ad3fa9d31..7f1c2f7d41 100644 --- a/erts/emulator/hipe/hipe_x86_stack.c +++ b/erts/emulator/hipe/hipe_x86_stack.c @@ -209,7 +209,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (return address, actuals, caller's frame). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -240,7 +240,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ 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..71c4239902 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -314,13 +314,16 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fds[2]; #endif +#if ERTS_POLL_USE_TIMERFD + int timer_fd; +#endif #if ERTS_POLL_USE_FALLBACK int fallback_used; #endif #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 +387,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 @@ -560,6 +583,75 @@ create_wakeup_pipe(ErtsPollSet ps) #endif /* ERTS_POLL_USE_WAKEUP_PIPE */ /* + * --- timer fd ----------------------------------------------------------- + */ + +#if ERTS_POLL_USE_TIMERFD + +/* We use the timerfd when using epoll_wait to get high accuracy + timeouts, i.e. we want to sleep with < ms accuracy. */ + +static void +create_timerfd(ErtsPollSet ps) +{ + int do_wake = 0; + int timer_fd; + timer_fd = timerfd_create(CLOCK_MONOTONIC,0); + ERTS_POLL_EXPORT(erts_poll_control)(ps, + timer_fd, + ERTS_POLL_EV_IN, + 1, &do_wake); +#if ERTS_POLL_USE_FALLBACK + /* We depend on the wakeup pipe being handled by kernel poll */ + if (ps->fds_status[timer_fd].flags & ERTS_POLL_FD_FLG_INFLBCK) + fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n", + __FILE__, __LINE__); +#endif + if (ps->internal_fd_limit <= timer_fd) + ps->internal_fd_limit = timer_fd + 1; + ps->timer_fd = timer_fd; +} + +static ERTS_INLINE void +timerfd_set(ErtsPollSet ps, struct itimerspec *its) +{ +#ifdef DEBUG + struct itimerspec old_its; + int res; + res = timerfd_settime(ps->timer_fd, 0, its, &old_its); + ASSERT(res == 0); + ASSERT(old_its.it_interval.tv_sec == 0 && + old_its.it_interval.tv_nsec == 0 && + old_its.it_value.tv_sec == 0 && + old_its.it_value.tv_nsec == 0); + +#else + timerfd_settime(ps->timer_fd, 0, its, NULL); +#endif +} + +static ERTS_INLINE int +timerfd_clear(ErtsPollSet ps, int res, int max_res) { + + struct itimerspec its; + /* we always have to clear the timer */ + its.it_interval.tv_sec = 0; + its.it_interval.tv_nsec = 0; + its.it_value.tv_sec = 0; + its.it_value.tv_nsec = 0; + timerfd_settime(ps->timer_fd, 0, &its, NULL); + + /* only timeout fd triggered */ + if (res == 1 && ps->res_events[0].data.fd == ps->timer_fd) + return 0; + + return res; +} + +#endif /* ERTS_POLL_USE_TIMERFD */ + + +/* * --- Poll set update requests ---------------------------------------------- */ #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE @@ -1497,6 +1589,12 @@ poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake goto done; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == ps->timer_fd) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } +#endif } if (fd >= ps->fds_status_len) @@ -1644,6 +1742,9 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fd = ps->wake_fds[0]; #endif +#if ERTS_POLL_USE_TIMERFD + int timer_fd = ps->timer_fd; +#endif for (i = 0; i < n; i++) { @@ -1659,6 +1760,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) continue; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == timer_fd) { + continue; + } +#endif ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); /* epoll_wait() can repeat the same fd in result array... */ ix = (int) ps->fds_status[fd].res_ev_ix; @@ -1733,6 +1839,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) continue; } #endif +#if ERTS_POLL_USE_TIMERFD + if (fd == timer_fd) { + continue; + } +#endif revents = ERTS_POLL_EV_N2E(ps->res_events[i].events); pr[res].fd = fd; pr[res].events = revents; @@ -1993,44 +2104,186 @@ 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 +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 || (ERTS_POLL_USE_POLL && defined(HAVE_PPOLL)) || ERTS_POLL_USE_TIMERFD + +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*1000); + + return !0; + } +} + +#endif + +#if ERTS_POLL_USE_TIMERFD + +static ERTS_INLINE int +get_timeout_itimerspec(ErtsPollSet ps, + struct itimerspec *itsp, + ErtsMonotonicTime timeout_time) +{ + + itsp->it_interval.tv_sec = 0; + itsp->it_interval.tv_nsec = 0; + + return get_timeout_timespec(ps, &itsp->it_value, timeout_time); +} + +#endif + static ERTS_INLINE int -check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) +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); +#if ERTS_POLL_USE_TIMERFD + { + struct itimerspec its; + timeout = get_timeout_itimerspec(ps, &its, timeout_time); + if (timeout) { +#ifdef ERTS_SMP + erts_thr_progress_prepare_wait(NULL); +#endif + timerfd_set(ps, &its); + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1); + res = timerfd_clear(ps, res, max_res); + } else { + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0); + } + } +#else /* !ERTS_POLL_USE_TIMERFD */ + timeout = (int) get_timeout(ps, 1000, timeout_time); #ifdef ERTS_SMP if (timeout) erts_thr_progress_prepare_wait(NULL); #endif - res = epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout); + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); +#endif /* !ERTS_POLL_USE_TIMERFD */ #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ struct timespec ts; if (max_res > ps->res_events_len) 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 +2302,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 +2311,41 @@ 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; +#elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */ + struct timespec ts; + timeout = get_timeout_timespec(ps, &ts, timeout_time); +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif + res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL); +#elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */ + timeout = (int) get_timeout(ps, 1000, timeout_time); #ifdef ERTS_SMP if (timeout) 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 +2368,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 +2393,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 +2410,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 +2421,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 +2433,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 +2476,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 +2520,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 { @@ -2414,6 +2667,9 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) #if ERTS_POLL_USE_WAKEUP_PIPE create_wakeup_pipe(ps); #endif +#if ERTS_POLL_USE_TIMERFD + create_timerfd(ps); +#endif #if ERTS_POLL_USE_FALLBACK if (kp_fd >= ps->fds_status_len) grow_fds_status(ps, kp_fd); @@ -2431,7 +2687,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); @@ -2504,6 +2760,10 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps) if (ps->wake_fds[1] >= 0) close(ps->wake_fds[1]); #endif +#if ERTS_POLL_USE_TIMERFD + if (ps->timer_fd >= 0) + close(ps->timer_fd); +#endif erts_smp_spin_lock(&pollsets_lock); if (ps == pollsets) @@ -2608,6 +2868,9 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip) #if ERTS_POLL_USE_WAKEUP_PIPE pip->poll_set_size++; /* Wakeup pipe */ #endif +#if ERTS_POLL_USE_TIMERFD + pip->poll_set_size++; /* timerfd */ +#endif pip->fallback_poll_set_size = #if !ERTS_POLL_USE_FALLBACK @@ -2736,14 +2999,18 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps, ev[fd] = 0; else { ev[fd] = ps->fds_status[fd].events; + if ( #if ERTS_POLL_USE_WAKEUP_PIPE - if (fd == ps->wake_fds[0] || fd == ps->wake_fds[1]) - ev[fd] |= ERTS_POLL_EV_NVAL; + fd == ps->wake_fds[0] || fd == ps->wake_fds[1] || +#endif +#if ERTS_POLL_USE_TIMERFD + fd == ps->timer_fd || #endif #if ERTS_POLL_USE_KERNEL_POLL - if (fd == ps->kp_fd) - ev[fd] |= ERTS_POLL_EV_NVAL; + fd == ps->kp_fd || #endif + 0) + ev[fd] |= ERTS_POLL_EV_NVAL; } } ERTS_POLLSET_UNLOCK(ps); diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 2f1c05f401..ae2d063805 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 @@ -96,6 +98,8 @@ # endif #endif +#define ERTS_POLL_USE_TIMERFD 0 + typedef Uint32 ErtsPollEvents; #undef ERTS_POLL_EV_E2N @@ -128,6 +132,12 @@ struct erts_sys_fd_type { #include <sys/epoll.h> +#ifdef HAVE_SYS_TIMERFD_H +#include <sys/timerfd.h> +#undef ERTS_POLL_USE_TIMERFD +#define ERTS_POLL_USE_TIMERFD 1 +#endif + #define ERTS_POLL_EV_E2N(EV) \ ((__uint32_t) (EV)) #define ERTS_POLL_EV_N2E(EV) \ @@ -241,7 +251,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 +264,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_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 5ad92dad02..d050748703 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -55,7 +55,7 @@ void sys_sigrelease(int sig) #endif /* !SIG_SIGSET */ #if defined(__ANDROID__) -int __system_properties_fd(void); +static int system_properties_fd(void); #endif /* __ANDROID__ */ #if defined(__ANDROID__) @@ -104,9 +104,12 @@ main(int argc, char *argv[]) #if defined(HAVE_CLOSEFROM) closefrom(from); #elif defined(__ANDROID__) - for (i = from; i <= to; i++) { - if (i!=__system_properties_fd) - (void) close(i); + if (from <= to) { + int spfd = system_properties_fd(); + for (i = from; i <= to; i++) { + if (i != spfd) + (void) close(i); + } } #else for (i = from; i <= to; i++) @@ -143,9 +146,9 @@ main(int argc, char *argv[]) } #if defined(__ANDROID__) -int __system_properties_fd(void) +static int system_properties_fd(void) { - int s, fd; + int fd; char *env; env = getenv("ANDROID_PROPERTY_WORKSPACE"); @@ -156,4 +159,3 @@ int __system_properties_fd(void) return fd; } #endif /* __ANDROID__ */ - diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 26ed2fb558..1942b631fc 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -45,7 +45,7 @@ #include <fcntl.h> #include "erl_errno.h" #include <signal.h> - +#include <setjmp.h> #if HAVE_SYS_SOCKETIO_H # include <sys/socketio.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,35 +155,134 @@ 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 + +ErtsSystemTime erts_os_system_time(void); + +#undef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT +#undef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT +#undef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ + +#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 + +/* + * 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); + +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__; + +extern ErtsSysTimeData__ erts_sys_time_data__; -#ifdef HAVE_GETHRTIME -#ifdef GETHRTIME_WITH_CLOCK_GETTIME -typedef long long SysHrTime; +#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT -extern SysHrTime sys_gethrtime(void); -#define sys_init_hrtime() /* Nothing */ +#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ +ERTS_GLB_INLINE +#endif +ErtsMonotonicTime erts_os_monotonic_time(void); -#else /* Real gethrtime (Solaris) */ +#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ +ERTS_GLB_INLINE +#endif +void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *); -typedef hrtime_t SysHrTime; +#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); +} -#define sys_gethrtime() gethrtime() -#define sys_init_hrtime() /* Nothing */ +#endif /* ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ */ -#endif /* GETHRTIME_WITH_CLOCK_GETTIME */ -#endif /* HAVE_GETHRTIME */ +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME)) +#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */ + +/* + * + */ + +#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) typedef long long SysCpuTime; typedef struct timespec SysTimespec; @@ -200,7 +294,7 @@ typedef struct timespec SysTimespec; int sys_start_hrvtime(void); int sys_stop_hrvtime(void); -#elif defined(HAVE_CLOCK_GETTIME) +#elif defined(HAVE_CLOCK_GETTIME_CPU_TIME) #define sys_clock_gettime(cid,tp) clock_gettime((cid),&(tp)) #define sys_get_proc_cputime(t,tp) sys_clock_gettime(CLOCK_PROCESS_CPUTIME_ID,(tp)) @@ -211,13 +305,8 @@ int sys_stop_hrvtime(void); #define SYS_CLOCK_RESOLUTION 1 /* These are defined in sys.c */ -#if defined(SIG_SIGSET) /* Old SysV */ -RETSIGTYPE (*sys_sigset())(); -#elif defined(SIG_SIGNAL) /* Old BSD */ -RETSIGTYPE (*sys_sigset())(); -#else -RETSIGTYPE (*sys_sigset(int, RETSIGTYPE (*func)(int)))(int); -#endif +typedef void (*SIGFUNC)(int); +extern SIGFUNC sys_signal(int, SIGFUNC); extern void sys_sigrelease(int); extern void sys_sigblock(int); extern void sys_stop_cat(void); @@ -247,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 @@ -354,4 +445,28 @@ extern int exit_async(void); #define ERTS_EXIT_AFTER_DUMP _exit +#if !defined(__APPLE__) && !defined(__MACH__) +/* Some OS X versions do not allow (ab)using signal handlers like this */ +#define ERTS_HAVE_TRY_CATCH 1 + +/* We try to simulate a try catch in C with the help of signal handlers. + * Only use this as a very last resort, as it is not very portable and + * quite unstable. It is also not thread safe, so make sure that only + * one thread can call this at a time! + */ +extern void erts_sys_sigsegv_handler(int); +extern jmp_buf erts_sys_sigsegv_jmp; +#define ERTS_SYS_TRY_CATCH(EXPR,CATCH) \ + do { \ + SIGFUNC prev_handler = sys_signal(SIGSEGV, \ + erts_sys_sigsegv_handler); \ + if (!setjmp(erts_sys_sigsegv_jmp)) { \ + EXPR; \ + } else { \ + CATCH; \ + } \ + sys_signal(SIGSEGV,prev_handler); \ + } while(0) +#endif + #endif /* #ifndef _ERL_UNIX_SYS_H */ diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index cd87b320e2..7d52650a70 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -34,6 +34,7 @@ #include <termios.h> #include <ctype.h> #include <sys/utsname.h> +#include <sys/select.h> #ifdef ISC32 #include <sys/bsdtypes.h> @@ -85,14 +86,24 @@ static erts_smp_rwmtx_t environ_rwmtx; #define DISABLE_VFORK 0 #endif +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + #ifdef USE_THREADS # ifdef ENABLE_CHILD_WAITER_THREAD # define CHLDWTHR ENABLE_CHILD_WAITER_THREAD # else # define CHLDWTHR 0 # endif +# define FDBLOCK 1 #else # define CHLDWTHR 0 +# define FDBLOCK 0 #endif /* * [OTP-3906] @@ -121,6 +132,15 @@ struct ErtsSysReportExit_ { #endif }; +/* Used by the fd driver iff the fd could not be set to non-blocking */ +typedef struct ErtsSysBlocking_ { + ErlDrvPDL pdl; + int res; + int err; + unsigned int pkey; +} ErtsSysBlocking; + + /* This data is shared by these drivers - initialized by spawn_init() */ static struct driver_data { ErlDrvPort port_num; @@ -129,6 +149,8 @@ static struct driver_data { int pid; int alive; int status; + int terminating; + ErtsSysBlocking *blocking; } *driver_data; /* indexed by fd */ static ErtsSysReportExit *report_exit_list; @@ -202,8 +224,14 @@ static erts_smp_atomic_t sys_misc_mem_sz; #if defined(ERTS_SMP) static void smp_sig_notify(char c); static int sig_notify_fds[2] = {-1, -1}; + +static int sig_suspend_fds[2] = {-1, -1}; +#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 + #endif +jmp_buf erts_sys_sigsegv_jmp; + #if CHLDWTHR || defined(ERTS_SMP) erts_mtx_t chld_stat_mtx; #endif @@ -280,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 *); @@ -386,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 @@ -504,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 */ @@ -531,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 @@ -541,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); @@ -554,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); { @@ -640,39 +679,7 @@ erl_sys_init(void) /* signal handling */ -#ifdef SIG_SIGSET /* Old SysV */ -RETSIGTYPE (*sys_sigset(sig, func))() -int sig; -RETSIGTYPE (*func)(); -{ - return(sigset(sig, func)); -} -void sys_sigblock(int sig) -{ - sighold(sig); -} -void sys_sigrelease(int sig) -{ - sigrelse(sig); -} -#else /* !SIG_SIGSET */ -#ifdef SIG_SIGNAL /* Old BSD */ -RETSIGTYPE (*sys_sigset(sig, func))(int, int) -int sig; -RETSIGTYPE (*func)(); -{ - return(signal(sig, func)); -} -sys_sigblock(int sig) -{ - sigblock(sig); -} -sys_sigrelease(int sig) -{ - sigsetmask(sigblock(0) & ~sigmask(sig)); -} -#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */ -RETSIGTYPE (*sys_sigset(int sig, RETSIGTYPE (*func)(int)))(int) +SIGFUNC sys_signal(int sig, SIGFUNC func) { struct sigaction act, oact; @@ -705,23 +712,35 @@ void sys_sigrelease(int sig) sigaddset(&mask, sig); sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); } -#endif /* !SIG_SIGNAL */ -#endif /* !SIG_SIGSET */ -#if (0) /* not used? -- gordon */ -static void (*break_func)(); -static RETSIGTYPE break_handler(int sig) -{ -#ifdef QNX - /* Turn off SIGCHLD during break processing */ - sys_sigblock(SIGCHLD); -#endif - (*break_func)(); -#ifdef QNX - sys_sigrelease(SIGCHLD); -#endif +void erts_sys_sigsegv_handler(int signo) { + if (signo == SIGSEGV) { + longjmp(erts_sys_sigsegv_jmp, 1); + } +} + +/* + * Function returns 1 if we can read from all values in between + * start and stop. + */ +int +erts_sys_is_area_readable(char *start, char *stop) { + int fds[2]; + if (!pipe(fds)) { + /* We let write try to figure out if the pointers are readable */ + int res = write(fds[1], start, (char*)stop - (char*)start); + if (res == -1) { + close(fds[0]); + close(fds[1]); + return 0; + } + close(fds[0]); + close(fds[1]); + return 1; + } + return 0; + } -#endif /* 0 */ static ERTS_INLINE int prepare_crash_dump(int secs) @@ -849,9 +868,23 @@ sigusr1_exit(void) #ifdef ETHR_UNUSABLE_SIGUSRX #warning "Unusable SIGUSR1 & SIGUSR2. Disabling use of these signals" -#endif -#ifndef ETHR_UNUSABLE_SIGUSRX +#else + +#ifdef ERTS_SMP +void +sys_thr_suspend(erts_tid_t tid) { + erts_thr_kill(tid, ERTS_SYS_SUSPEND_SIGNAL); +} + +void +sys_thr_resume(erts_tid_t tid) { + int i = 0, res; + do { + res = write(sig_suspend_fds[1],&i,sizeof(i)); + } while (res < 0 && errno == EAGAIN); +} +#endif #if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) static RETSIGTYPE user_signal1(void) @@ -866,20 +899,20 @@ static RETSIGTYPE user_signal1(int signum) #endif } -#ifdef QUANTIFY +#ifdef ERTS_SMP #if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE user_signal2(void) +static RETSIGTYPE suspend_signal(void) #else -static RETSIGTYPE user_signal2(int signum) +static RETSIGTYPE suspend_signal(int signum) #endif { -#ifdef ERTS_SMP - smp_sig_notify('2'); -#else - quantify_save_data(); -#endif + int res; + int buf[1]; + do { + res = read(sig_suspend_fds[0], buf, sizeof(int)); + } while (res < 0 && errno == EINTR); } -#endif +#endif /* #ifdef ERTS_SMP */ #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ @@ -904,9 +937,9 @@ static RETSIGTYPE do_quit(int signum) /* Disable break */ void erts_set_ignore_break(void) { - sys_sigset(SIGINT, SIG_IGN); - sys_sigset(SIGQUIT, SIG_IGN); - sys_sigset(SIGTSTP, SIG_IGN); + sys_signal(SIGINT, SIG_IGN); + sys_signal(SIGQUIT, SIG_IGN); + sys_signal(SIGTSTP, SIG_IGN); } /* Don't use ctrl-c for break handler but let it be @@ -929,14 +962,14 @@ void erts_replace_intr(void) { void init_break_handler(void) { - sys_sigset(SIGINT, request_break); + sys_signal(SIGINT, request_break); #ifndef ETHR_UNUSABLE_SIGUSRX - sys_sigset(SIGUSR1, user_signal1); -#ifdef QUANTIFY - sys_sigset(SIGUSR2, user_signal2); -#endif + sys_signal(SIGUSR1, user_signal1); +#ifdef ERTS_SMP + sys_signal(ERTS_SYS_SUSPEND_SIGNAL, suspend_signal); +#endif /* #ifdef ERTS_SMP */ #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ - sys_sigset(SIGQUIT, do_quit); + sys_signal(SIGQUIT, do_quit); } int sys_max_files(void) @@ -953,8 +986,13 @@ static void block_signals(void) sys_sigblock(SIGINT); #ifndef ETHR_UNUSABLE_SIGUSRX sys_sigblock(SIGUSR1); +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ +#endif /* #ifndef ERTS_SMP */ + +#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) + sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL); #endif -#endif + } static void unblock_signals(void) @@ -968,26 +1006,13 @@ static void unblock_signals(void) #ifndef ETHR_UNUSABLE_SIGUSRX sys_sigrelease(SIGUSR1); #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ +#endif /* #ifndef ERTS_SMP */ + +#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) + sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL); #endif -} -/************************** 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 *******************************/ @@ -1094,11 +1119,16 @@ void fini_getenv_state(GETENV_STATE *state) /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +#if FDBLOCK +static void fd_async(void *); +static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); +#endif static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); static int spawn_init(void); static void fd_stop(ErlDrvData); +static void fd_flush(ErlDrvData); static void stop(ErlDrvData); static void ready_input(ErlDrvData, ErlDrvEvent); static void ready_output(ErlDrvData, ErlDrvEvent); @@ -1143,8 +1173,12 @@ struct erl_drv_entry fd_driver_entry = { fd_control, NULL, outputv, - NULL, /* ready_async */ - NULL, /* flush */ +#if FDBLOCK + fd_ready_async, /* ready_async */ +#else + NULL, +#endif + fd_flush, /* flush */ NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, @@ -1198,13 +1232,28 @@ static RETSIGTYPE onchld(int signum) #endif } +static int set_blocking_data(struct driver_data *dd) { + + dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); + + erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); + + dd->blocking->pdl = driver_pdl_create(dd->port_num); + dd->blocking->res = 0; + dd->blocking->err = 0; + dd->blocking->pkey = driver_async_port_key(dd->port_num); + + return 1; +} + static int set_driver_data(ErlDrvPort port_num, int ifd, int ofd, int packet_bytes, int read_write, int exit_status, - int pid) + int pid, + int is_blocking) { Port *prt; ErtsSysReportExit *report_exit; @@ -1236,8 +1285,13 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ifd].pid = pid; driver_data[ifd].alive = 1; driver_data[ifd].status = 0; + driver_data[ifd].terminating = 0; + driver_data[ifd].blocking = NULL; if (read_write & DO_WRITE) { driver_data[ifd].ofd = ofd; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ifd)) + return -1; if (ifd != ofd) driver_data[ofd] = driver_data[ifd]; /* structure copy */ } else { /* DO_READ only */ @@ -1253,6 +1307,11 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ofd].pid = pid; driver_data[ofd].alive = 1; driver_data[ofd].status = 0; + driver_data[ofd].terminating = 0; + driver_data[ofd].blocking = NULL; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ofd)) + return -1; return(ofd); } } @@ -1262,11 +1321,13 @@ static int spawn_init() int i; #if CHLDWTHR erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 0; thr_opts.suggested_stack_size = 0; /* Smallest possible */ + thr_opts.name = "child_waiter"; #endif - sys_sigset(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ + sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ driver_data = (struct driver_data *) erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); erts_smp_atomic_add_nob(&sys_misc_mem_sz, @@ -1279,7 +1340,7 @@ static int spawn_init() sys_sigblock(SIGCHLD); #endif - sys_sigset(SIGCHLD, onchld); /* Reap children */ + sys_signal(SIGCHLD, onchld); /* Reap children */ #if CHLDWTHR erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); @@ -1745,7 +1806,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - opts->read_write, opts->exit_status, pid); + opts->read_write, opts->exit_status, pid, 0); /* Don't unblock SIGCHLD until now, since the call above must first complete putting away the info about our new subprocess. */ unblock_signals(); @@ -1830,6 +1891,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) { ErlDrvData res; + int non_blocking = 0; if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) @@ -1902,6 +1964,20 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, * case - it can be called with any old pre-existing file descriptors, * the relations between which (if they're even two) we can only guess * at - still, we try our best... + * + * Added note OTP 18: Some systems seem to use stdout/stderr to log data + * using unix pipes, so we cannot allow the system to block on a write. + * Therefore we use an async thread to write the data to fd's that could + * not be set to non-blocking. When no async threads are available we + * fall back on the old behaviour. + * + * Also the guarantee about what is delivered to the OS has changed. + * Pre 18 the fd driver did no flushing of data before terminating. + * Now it does. This is because we want to be able to guarantee that things + * such as escripts and friends really have outputted all data before + * terminating. This could potentially block the termination of the system + * for a very long time, but if the user wants to terminate fast she should + * use erlang:halt with flush=false. */ if (opts->read_write & DO_READ) { @@ -1924,6 +2000,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, imagine a scenario where setting non-blocking mode here would cause problems - go ahead and do it. */ + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } else { /* output fd is a tty, input fd isn't */ @@ -1966,6 +2043,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, (nfd = open(tty, O_WRONLY)) != -1) { dup2(nfd, opts->ofd); close(nfd); + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } } @@ -1974,8 +2052,9 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, } CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); CHLD_STAT_UNLOCK; return res; } @@ -2001,14 +2080,30 @@ static void nbio_stop_fd(ErlDrvPort prt, int fd) SET_BLOCKING(fd); } -static void fd_stop(ErlDrvData fd) /* Does not close the fds */ +static void fd_stop(ErlDrvData ev) /* Does not close the fds */ { int ofd; + int fd = (int)(long)ev; + ErlDrvPort prt = driver_data[fd].port_num; - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd); - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && ofd != -1) - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd); +#if FDBLOCK + if (driver_data[fd].blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); + driver_data[fd].blocking = NULL; + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); + } +#endif + + nbio_stop_fd(prt, fd); + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) + nbio_stop_fd(prt, ofd); +} + +static void fd_flush(ErlDrvData fd) +{ + if (!driver_data[(int)(long)fd].terminating) + driver_data[(int)(long)fd].terminating = 1; } static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, @@ -2031,8 +2126,8 @@ static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, 0); CHLD_STAT_UNLOCK; return res; } @@ -2069,6 +2164,7 @@ static void stop(ErlDrvData fd) } } +/* used by fd_driver */ static void outputv(ErlDrvData e, ErlIOVec* ev) { int fd = (int)(long)e; @@ -2094,12 +2190,21 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) ev->iov[0].iov_base = lbp; ev->iov[0].iov_len = pb; ev->size += pb; + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_lock(driver_data[fd].blocking->pdl); + if ((sz = driver_sizeq(ix)) > 0) { driver_enqv(ix, ev, 0); + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_unlock(driver_data[fd].blocking->pdl); + if (sz + ev->size >= (1 << 13)) set_busy_port(ix, 1); } - else { + else if (!driver_data[fd].blocking || !FDBLOCK) { + /* We try to write directly if the fd in non-blocking */ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; n = writev(ofd, (const void *) (ev->iov), vsize); @@ -2115,10 +2220,22 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) driver_enqv(ix, ev, n); /* n is the skip value */ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); } +#if FDBLOCK + else { + if (ev->size != 0) { + driver_enqv(ix, ev, 0); + driver_pdl_unlock(driver_data[fd].blocking->pdl); + driver_async(ix, &driver_data[fd].blocking->pkey, + fd_async, driver_data+fd, NULL); + } else { + driver_pdl_unlock(driver_data[fd].blocking->pdl); + } + } +#endif /* return 0;*/ } - +/* Used by spawn_driver and vanilla driver */ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) { int fd = (int)(long)e; @@ -2181,6 +2298,23 @@ static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) ASSERT(res <= 0); (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); clear_fd_data(ready_fd); + + if (driver_data[ready_fd].blocking && FDBLOCK) { + driver_pdl_lock(driver_data[ready_fd].blocking->pdl); + if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + /* We have stuff in the output queue, so we just + set the state to terminating and wait for fd_async_ready + to terminate the port */ + if (res == 0) + driver_data[ready_fd].terminating = 2; + else + driver_data[ready_fd].terminating = -err; + return 0; + } + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + } + if (res == 0) { if (driver_data[ready_fd].report_exit) { CHLD_STAT_LOCK; @@ -2231,6 +2365,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) port_num = driver_data[fd].port_num; packet_bytes = driver_data[fd].packet_bytes; + if (packet_bytes == 0) { byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, ERTS_SYS_READ_BUF_SZ); @@ -2354,6 +2489,8 @@ static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + if (driver_data[fd].terminating) + driver_failure_atom(driver_data[fd].port_num,"normal"); return; /* 0; */ } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -2379,6 +2516,78 @@ static void stop_select(ErlDrvEvent fd, void* _) close((int)fd); } +#if FDBLOCK + +static void +fd_async(void *async_data) +{ + int res; + struct driver_data *dd = (struct driver_data*)async_data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int err; + /* much of this code is stolen from efile_drv:invoke_writev */ + driver_pdl_lock(dd->blocking->pdl); + iov0 = driver_peekq(dd->port_num, &iovlen); + iovlen = iovlen < MAXIOV ? iovlen : MAXIOV; + iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF, + sizeof(SysIOVec)*iovlen); + if (!iov) { + res = -1; + err = ENOMEM; + driver_pdl_unlock(dd->blocking->pdl); + } else { + memcpy(iov,iov0,iovlen*sizeof(SysIOVec)); + driver_pdl_unlock(dd->blocking->pdl); + + res = writev(dd->ofd, iov, iovlen); + err = errno; + + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + } + dd->blocking->res = res; + dd->blocking->err = err; +} + +void fd_ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) { + struct driver_data *dd = (struct driver_data *)thread_data; + ErlDrvPort port_num = dd->port_num; + + ASSERT(dd->blocking); + ASSERT(dd == (driver_data + (int)(long)drv_data)); + + if (dd->blocking->res > 0) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_deq(port_num, dd->blocking->res) == 0) { + driver_pdl_unlock(dd->blocking->pdl); + set_busy_port(port_num, 0); + if (dd->terminating) { + /* The port is has been ordered to terminate + from either fd_flush or port_inp_failure */ + if (dd->terminating == 1) + driver_failure_atom(port_num, "normal"); + else if (dd->terminating == 2) + driver_failure_eof(port_num); + else if (dd->terminating < 0) + driver_failure_posix(port_num, -dd->terminating); + return; /* -1; */ + } + } else { + driver_pdl_unlock(dd->blocking->pdl); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + return /* 0; */; + } + } else if (dd->blocking->res < 0) { + driver_failure_posix(port_num, dd->blocking->err); + return; /* -1; */ + } + return; /* 0; */ +} + +#endif void erts_do_break_handling(void) { @@ -2648,18 +2857,30 @@ void sys_preload_end(Preload* p) /* Nothing */ } -/* Read a key from console (?) */ - +/* Read a key from console, used by break.c + Here we assume that all schedulers are stopped so that erl_poll + does not interfere with the select below. +*/ int sys_get_key(fd) int fd; { - int c; + int c, ret; unsigned char rbuf[64]; + fd_set fds; fflush(stdout); /* Flush query ??? */ - if ((c = read(fd,rbuf,64)) <= 0) { - return c; + FD_ZERO(&fds); + FD_SET(fd,&fds); + + ret = select(fd+1, &fds, NULL, NULL, NULL); + + if (ret == 1) { + do { + c = read(fd,rbuf,64); + } while (c < 0 && errno == EAGAIN); + if (c <= 0) + return c; } return rbuf[0]; @@ -2983,13 +3204,6 @@ signal_dispatcher_thread_func(void *unused) case '1': /* SIGUSR1 */ sigusr1_exit(); break; -#ifdef QUANTIFY - case '2': /* SIGUSR2 */ - quantify_save_data(); /* Might take a substantial amount of - time, but this is a test/debug - build */ - break; -#endif default: erl_exit(ERTS_ABORT_EXIT, "signal-dispatcher thread received unknown " @@ -3007,6 +3221,7 @@ init_smp_sig_notify(void) { erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; thr_opts.detached = 1; + thr_opts.name = "sys_sig_dispatcher"; if (pipe(sig_notify_fds) < 0) { erl_exit(ERTS_ABORT_EXIT, @@ -3021,6 +3236,17 @@ init_smp_sig_notify(void) NULL, &thr_opts); } + +static void +init_smp_sig_suspend(void) { + if (pipe(sig_suspend_fds) < 0) { + erl_exit(ERTS_ABORT_EXIT, + "Failed to create sig_suspend pipe: %s (%d)\n", + erl_errno_id(errno), + errno); + } +} + #ifdef __DARWIN__ int erts_darwin_main_thread_pipe[2]; @@ -3048,9 +3274,11 @@ erts_sys_main_thread(void) #endif smp_sig_notify(0); /* Notify initialized */ - while (1) { - /* Wait for a signal to arrive... */ + + /* Wait for a signal to arrive... */ + #ifdef __DARWIN__ + while (1) { /* * The wx driver needs to be able to steal the main thread for Cocoa to * work properly. @@ -3065,12 +3293,24 @@ erts_sys_main_thread(void) void* (*func)(void*); void* arg; void *resp; - read(erts_darwin_main_thread_pipe[0],&func,sizeof(void* (*)(void*))); - read(erts_darwin_main_thread_pipe[0],&arg, sizeof(void*)); + res = read(erts_darwin_main_thread_pipe[0],&func,sizeof(void* (*)(void*))); + if (res != sizeof(void* (*)(void*))) + break; + res = read(erts_darwin_main_thread_pipe[0],&arg,sizeof(void*)); + if (res != sizeof(void*)) + break; resp = (*func)(arg); write(erts_darwin_main_thread_result_pipe[1],&resp,sizeof(void *)); } -#else + + if (res == -1 && errno != EINTR) + break; + } + /* Something broke with the main thread pipe, so we ignore it for now. + Most probably erts has closed this pipe and is about to exit. */ +#endif /* #ifdef __DARWIN__ */ + + while (1) { #ifdef DEBUG int res = #else @@ -3079,7 +3319,6 @@ erts_sys_main_thread(void) select(0, NULL, NULL, NULL, NULL); ASSERT(res < 0); ASSERT(errno == EINTR); -#endif } } @@ -3171,6 +3410,7 @@ erl_sys_args(int* argc, char** argv) #ifdef ERTS_SMP init_smp_sig_notify(); + init_smp_sig_suspend(); #endif /* Handled arguments have been marked with NULL. Slide arguments diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index cafeab547e..c30ef7cce2 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -32,7 +32,7 @@ void erts_sys_init_float(void) { # ifdef SIGFPE - sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */ + sys_signal(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */ # endif } @@ -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) @@ -667,7 +667,7 @@ static void fpe_sig_handler(int sig) static void erts_thread_catch_fp_exceptions(void) { - sys_sigset(SIGFPE, fpe_sig_handler); + sys_signal(SIGFPE, fpe_sig_handler); unmask_fpe(); } 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 838f0c61eb..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) @@ -236,4 +298,16 @@ typedef long ssize_t; int init_async(int); int exit_async(void); #endif + +#define ERTS_HAVE_TRY_CATCH 1 + +#define ERTS_SYS_TRY_CATCH(EXPR,CATCH) \ + __try { \ + EXPR; \ + } \ + __except(GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) \ + { \ + CATCH; \ + } + #endif diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 0ded6b274e..cf587af4ac 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -247,6 +247,27 @@ void erl_sys_args(int* argc, char** argv) #endif } +/* + * Function returns 1 if we can read from all values in between + * start and stop. + */ +int +erts_sys_is_area_readable(char *start, char *stop) { + volatile char tmp; + __try + { + while(start < stop) { + tmp = *start; + start++; + } + } + __except(EXCEPTION_EXECUTE_HANDLER) + { + return 0; + } + return 1; +} + int erts_sys_prepare_crash_dump(int secs) { Port *heart_port; @@ -1392,39 +1413,46 @@ int parse_command(wchar_t* cmd){ return i; } -static BOOL need_quotes(wchar_t *str) -{ - int in_quote = 0; - int backslashed = 0; - int naked_space = 0; - while (*str != L'\0') { - switch (*str) { - case L'\\' : - backslashed = !backslashed; - break; - case L'"': - if (backslashed) { - backslashed=0; - } else { - in_quote = !in_quote; - } - break; - case L' ': - backslashed = 0; - if (!(backslashed || in_quote)) { - naked_space++; - } - break; - default: - backslashed = 0; +/* + * Translating of command line arguments to correct format. In the examples + * below the '' are not part of the actual string. + * 'io:format("hello").' -> 'io:format(\"hello\").' + * 'io:format("is anybody in there?").' -> '"io:format(\"is anybody in there?\")."' + * 'Just nod if you can hear me.' -> '"Just nod if you can hear me."' + * 'Is there ""anyone at home?' -> '"Is there \"\"anyone at home?"' + * 'Relax."' -> 'Relax.\"' + * + * If new == NULL we just calculate the length. + * + * The reason for having to quote all of the is becasue CreateProcessW removes + * one level of escaping since it takes a single long command line rather + * than the argument chunks that unix uses. + */ +static int escape_and_quote(wchar_t *str, wchar_t *new, BOOL *quoted) { + int i, j = 0; + if (new == NULL) + *quoted = FALSE; + else if (*quoted) + new[j++] = L'"'; + for ( i = 0; str[i] != L'\0'; i++,j++) { + if (str[i] == L' ' && new == NULL && *quoted == FALSE) { + *quoted = TRUE; + j++; + } + /* check if we have to escape quotes */ + if (str[i] == L'"') { + if (new) new[j] = L'\\'; + j++; } - ++str; + if (new) new[j] = str[i]; + } + if (*quoted) { + if (new) new[j] = L'"'; + j++; } - return (naked_space > 0); + return j; } - - /* *---------------------------------------------------------------------- @@ -1585,31 +1613,24 @@ create_child_process wcscpy(appname, execPath); } if (argv == NULL) { - BOOL orig_need_q = need_quotes(execPath); + BOOL orig_need_q; wchar_t *ptr; - int ocl = wcslen(execPath); + int ocl = escape_and_quote(execPath, NULL, &orig_need_q); if (run_cmd) { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1) - + 11)*sizeof(wchar_t)); + (ocl + 1 + 11)*sizeof(wchar_t)); memcpy(newcmdline,L"cmd.exe /c ",11*sizeof(wchar_t)); ptr = newcmdline + 11; } else { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1))*sizeof(wchar_t)); + (ocl + 1)*sizeof(wchar_t)); ptr = (wchar_t *) newcmdline; } - if (orig_need_q) { - *ptr++ = L'"'; - } - memcpy(ptr,execPath,ocl*sizeof(wchar_t)); - ptr += ocl; - if (orig_need_q) { - *ptr++ = L'"'; - } - *ptr = L'\0'; + ptr += escape_and_quote(execPath, ptr, &orig_need_q); + ptr[0] = L'\0'; } else { - int sum = 1; /* '\0' */ + int sum = 0; + BOOL *qte = NULL; wchar_t **ar = argv; wchar_t *n; wchar_t *save_arg0 = NULL; @@ -1620,11 +1641,13 @@ create_child_process if (run_cmd) { sum += 11; /* cmd.exe /c */ } + + while (*ar != NULL) ar++; + qte = erts_alloc(ERTS_ALC_T_TMP, (ar - argv)*sizeof(BOOL)); + + ar = argv; while (*ar != NULL) { - sum += wcslen(*ar); - if (need_quotes(*ar)) { - sum += 2; /* quotes */ - } + sum += escape_and_quote(*ar,NULL,qte+(ar - argv)); sum++; /* space */ ++ar; } @@ -1636,26 +1659,18 @@ create_child_process n += 11; } while (*ar != NULL) { - int q = need_quotes(*ar); - sum = wcslen(*ar); - if (q) { - *n++ = L'"'; - } - memcpy(n,*ar,sum*sizeof(wchar_t)); - n += sum; - if (q) { - *n++ = L'"'; - } + n += escape_and_quote(*ar,n,qte+(ar - argv)); *n++ = L' '; ++ar; } - *(n-1) = L'\0'; + *(n-1) = L'\0'; /* overwrite last space with '\0' */ if (save_arg0 != NULL) { argv[0] = save_arg0; } + erts_free(ERTS_ALC_T_TMP, qte); } - DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags)); + DEBUGF((stderr,"Creating child process: %S, createFlags = %d\n", newcmdline, createFlags)); ok = CreateProcessW((wchar_t *) appname, (wchar_t *) newcmdline, NULL, @@ -2190,7 +2205,7 @@ static void fd_stop(ErlDrvData data) ASSERT(dp->out.flushEvent); SetEvent(dp->out.flushEvent); } while (WaitForSingleObject(dp->out.flushReplyEvent, 10) == WAIT_TIMEOUT - || !(dp->out.flags & DF_THREAD_FLUSHED)); + && !(dp->out.flags & DF_THREAD_FLUSHED)); } } @@ -3157,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_init_sys_time_sup(); - erts_thr_init(&eid); +#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); } @@ -3258,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..c855481489 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -27,7 +27,8 @@ init_per_group/2,end_per_group/2, t_after/1, receive_after/1, receive_after_big/1, receive_after_errors/1, receive_var_zero/1, receive_zero/1, - multi_timeout/1, receive_after_32bit/1]). + multi_timeout/1, receive_after_32bit/1, + receive_after_blast/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -40,7 +41,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [t_after, receive_after, receive_after_big, receive_after_errors, receive_var_zero, receive_zero, - multi_timeout, receive_after_32bit]. + multi_timeout, receive_after_32bit, receive_after_blast]. groups() -> []. @@ -70,30 +71,23 @@ end_per_testcase(_Func, Config) -> t_after(Config) when is_list(Config) -> ?line spawn(fun frequent_process/0), ?line Period = test_server:minutes(1), - ?line Before = erlang:now(), + ?line Before = erlang:monotonic_time(), receive after Period -> - ?line After = erlang:now(), + ?line After = erlang:monotonic_time(), ?line report(Period, Before, After) end. - report(Period, Before, After) -> - ?line Elapsed = (element(1, After)*1000000000 - +element(2, After)*1000 - +element(3, After) div 1000) - - (element(1,Before)*1000000000 - + element(2,Before)*1000 + element(3,Before) div 1000), - ?line case Elapsed*100 / Period of - Percent when Percent > 100.10 -> - ?line test_server:fail({too_inaccurate, Percent}); - Percent when Percent < 100.0 -> - ?line test_server:fail({too_early, Percent}); - Percent -> - ?line Comment = io_lib:format("Elapsed/expected: ~.2f %", - [Percent]), - {comment, lists:flatten(Comment)} - end. + case erlang:convert_time_unit(After - Before, native, 100*1000) / Period of + Percent when Percent > 100.10 -> + test_server:fail({too_inaccurate, Percent}); + Percent when Percent < 100.0 -> + test_server:fail({too_early, Percent}); + Percent -> + Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]), + {comment, lists:flatten(Comment)} + end. frequent_process() -> receive @@ -251,4 +245,26 @@ recv_after_32bit(I, T) when I rem 2 =:= 0 -> receive after T -> exit(timeout) end; recv_after_32bit(_, _) -> receive after 16#ffffFFFF -> exit(timeout) end. - + +blaster() -> + receive + {go, TimeoutTime} -> + Tmo = TimeoutTime - erlang:monotonic_time(milli_seconds), + receive after Tmo -> ok end + end. + +spawn_blasters(0) -> + []; +spawn_blasters(N) -> + [spawn_monitor(fun () -> blaster() end)|spawn_blasters(N-1)]. + +receive_after_blast(Config) when is_list(Config) -> + PMs = spawn_blasters(10000), + TimeoutTime = erlang:monotonic_time(milli_seconds) + 5000, + lists:foreach(fun ({P, _}) -> P ! {go, TimeoutTime} end, PMs), + lists:foreach(fun ({P, M}) -> + receive + {'DOWN', M, process, P, normal} -> + ok + end + end, PMs). diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 35c44c229a..12a48cc484 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -241,18 +241,15 @@ receive_drv_result(Port, CaseName) -> start_node(Config) -> start_node(Config, []). start_node(Config, Opts) when is_list(Config), is_list(Opts) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). stop_node(Node) -> ?t:stop_node(Node). diff --git a/erts/emulator/test/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/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index fbc229bc53..fc9bdae0a0 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -20,6 +20,7 @@ -module(bif_SUITE). -include_lib("test_server/include/test_server.hrl"). +-include_lib("kernel/include/file.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -681,8 +682,38 @@ erlang_halt(Config) when is_list(Config) -> {badrpc,nodedown} = rpc:call(N2, erlang, halt, [0]), {ok,N3} = slave:start(H, halt_node3), {badrpc,nodedown} = rpc:call(N3, erlang, halt, [0,[]]), - ok. + % This test triggers a segfault when dumping a crash dump + % to make sure that we can handle it properly. + {ok,N4} = slave:start(H, halt_node4), + CrashDump = filename:join(proplists:get_value(priv_dir,Config), + "segfault_erl_crash.dump"), + true = rpc:call(N4, os, putenv, ["ERL_CRASH_DUMP",CrashDump]), + false = rpc:call(N4, erts_debug, set_internal_state, + [available_internal_state, true]), + {badrpc,nodedown} = rpc:call(N4, erts_debug, set_internal_state, + [broken_halt, "Validate correct crash dump"]), + ok = wait_until_stable_size(CrashDump,-1), + {ok, Bin} = file:read_file(CrashDump), + case {string:str(binary_to_list(Bin),"\n=end\n"), + string:str(binary_to_list(Bin),"\r\n=end\r\n")} of + {0,0} -> ct:fail("Could not find end marker in crash dump"); + _ -> ok + end. + +wait_until_stable_size(_File,-10) -> + {error,enoent}; +wait_until_stable_size(File,PrevSz) -> + timer:sleep(250), + case file:read_file_info(File) of + {error,enoent} -> + wait_until_stable_size(File,PrevSz-1); + {ok,#file_info{size = PrevSz }} when PrevSz /= -1 -> + io:format("Crashdump file size was: ~p (~s)~n",[PrevSz,File]), + ok; + {ok,#file_info{size = NewSz }} -> + wait_until_stable_size(File,NewSz) + end. %% Helpers 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 e877f7a240..b739250aad 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,25 +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 @@ -89,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, @@ -97,10 +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() -> []. @@ -126,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 =) @@ -147,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(#{})), @@ -174,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, [ @@ -191,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} ]), @@ -211,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). @@ -224,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}), @@ -243,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. @@ -267,15 +991,124 @@ 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) -> true = map_guard_head(#{a=>1}), false = map_guard_head([]), @@ -305,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}; @@ -330,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. @@ -359,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. @@ -389,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) -> @@ -434,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 @@ -442,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) -> @@ -471,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"}), @@ -500,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,#{}), @@ -510,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. @@ -537,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) -> @@ -584,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. @@ -598,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, #{})), @@ -641,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), @@ -666,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) -> @@ -693,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. @@ -704,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) -> @@ -732,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. @@ -820,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>> @@ -858,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. @@ -903,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}]), @@ -916,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}]))), @@ -925,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), @@ -963,6 +2503,74 @@ 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), @@ -1004,6 +2612,80 @@ t_erts_internal_order(_Config) when is_list(_Config) -> 1 = maps:get(0,M1), ok. +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), + + M1 = M#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = M#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), + ok. t_pdict(_Config) -> @@ -1131,5 +2813,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 fdce157abc..d3c884689f 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -30,6 +30,7 @@ -export([fpe/1]). -export([otp_9422/1]). -export([faulty_seq_trace/1, do_faulty_seq_trace/0]). +-export([maps/1]). -export([runner/2, loop_runner/3]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). -export([do_boxed_and_small/0]). @@ -62,7 +63,8 @@ all() -> moving_labels, faulty_seq_trace, empty_list, - otp_9422]; + otp_9422, + maps]; true -> [not_run] end. @@ -899,6 +901,74 @@ fpe(Config) when is_list(Config) -> _ -> ok end. +maps(Config) when is_list(Config) -> + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{'_',[],['$_']}], table), + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{#{},[],['$_']}], table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{not_a_map,[],['$_']}], table), + {ok,bar,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => '$1'},[],['$1']}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => qux},[],[qux]}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{#{foo => '_'},[],[foo]}], table), + {error,_} = + erlang:match_spec_test(#{}, [{#{'$1' => '_'},[],[foo]}], table), + {ok,bar,[],[]} = + erlang:match_spec_test({#{foo => bar}}, + [{{#{foo => '$1'}},[],['$1']}], + 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 8a63d9fe3e..1125cf3072 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -24,7 +24,7 @@ -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, - exports/1,functions/1,native/1]). + exports/1,functions/1,native/1,info/1]). %%-compile(native). @@ -52,8 +52,8 @@ end_per_group(_GroupName, Config) -> Config. -modules() -> - [exports, functions, native]. +modules() -> + [exports, functions, native, info]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), @@ -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), @@ -122,6 +125,22 @@ native_proj({Name,Arity,Addr}) -> native_filter(Set) -> sofs:no_elements(Set) =/= 1. +%% Test that the module info of this module is correct. Use +%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks. +info(Config) when is_list(Config) -> + Info = erlang:get_module_info(?MODULE), + All = all_exported(), + {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)), + {module, ?MODULE} = lists:keyfind(module, 1, Info), + {md5, MD5} = lists:keyfind(md5, 1, Info), + {exports, Exports} = lists:keyfind(exports, 1, Info), + All = lists:sort(Exports), + {attributes, Attrs} = lists:keyfind(attributes, 1, Info), + {vsn,_} = lists:keyfind(vsn, 1, Attrs), + {compile, Compile} = lists:keyfind(compile, 1, Info), + {options,_} = lists:keyfind(options, 1, Compile), + ok. + %% Helper functions (local). add_arity(L) -> diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index aec59867d8..7326dfceb1 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), @@ -663,110 +665,96 @@ list_cleanup(Config) when is_list(Config) -> mixer(doc) -> "Test mixing of internal and external monitors."; mixer(Config) when is_list(Config) -> - ?line PA = filename:dirname(code:which(?MODULE)), - ?line NN = [j0,j1,j2,j3], -% ?line NN = [j0,j1], - ?line NL0 = [begin - {ok, J} = test_server:start_node - (X, slave, [{args, "-pa " ++ PA}]), - J - end || X <- NN], - ?line NL1 = lists:duplicate(2,node()) ++ NL0, - ?line Perm = perm(NL1), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,[]} = process_info(self(),monitors), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js], - ?line wait_for_m([],[],200) - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line Rs = [begin - {monitor_process,Ref} = - ask_jeeves(P,{monitor_process,self()}), - {P,Ref} - end - || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,[]} = process_info(self(),monitors), - ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], - ?line wait_for_m([],[],200), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], - ?line [erlang:monitor(process,P) || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,M} = - process_info(self(),monitors), - ?line ML = lists:sort([P||{process,P} <- M]), - ?line ML = JsL, - ?line [begin - tell_jeeves(P,{exit,flaff}), - receive {'DOWN',_,process,P,_} -> ok end - end || P <- Js], - ?line wait_for_m([],[],200) - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line Rs = [begin - {monitor_process,Ref} = - ask_jeeves(P,{monitor_process,self()}), - {P,Ref} - end - || P <- Js], - ?line R2s = [{P,erlang:monitor(process,P)} || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,M} = - process_info(self(),monitors), - ?line ML = lists:sort([P||{process,P} <- M]), - ?line ML = JsL, - ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], - ?line wait_for_m(lists:sort(M),[],200), - ?line [erlang:demonitor(Ref) || {_P,Ref} <- R2s], - ?line wait_for_m([],[],200), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] - end, - Perm), - [test_server:stop_node(K) || K <- NL0 ], + PA = filename:dirname(code:which(?MODULE)), + NN = [j0,j1,j2], + NL0 = [begin + {ok, J} = test_server:start_node(X,slave,[{args, "-pa " ++ PA}]), + J + end || X <- NN], + NL1 = lists:duplicate(2,node()) ++ NL0, + Perm = perm(NL1), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,[]} = process_info(self(),monitors), + [tell_jeeves(P,{exit,flaff}) || P <- Js], + wait_for_m([],[],200) + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + Rs = [begin + {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,[]} = process_info(self(),monitors), + [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + wait_for_m([],[],200), + [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + [erlang:monitor(process,P) || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,M} = process_info(self(),monitors), + ML = lists:sort([P||{process,P} <- M]), + ML = JsL, + [begin + tell_jeeves(P,{exit,flaff}), + receive {'DOWN',_,process,P,_} -> ok end + end || P <- Js], + wait_for_m([],[],200) + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + Rs = [begin + {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end || P <- Js], + R2s = [{P,erlang:monitor(process,P)} || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,M} = process_info(self(),monitors), + ML = lists:sort([P||{process,P} <- M]), + ML = JsL, + [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + wait_for_m(lists:sort(M),[],200), + [erlang:demonitor(Ref) || {_P,Ref} <- R2s], + wait_for_m([],[],200), + [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + [test_server:stop_node(K) || K <- NL0], ok. 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 +825,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 +1030,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..778f6fd087 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -39,7 +39,9 @@ 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, call_dirty_nif_exception/1, nif_schedule/1, + nif_exception/1, call_nif_exception/1, + nif_nan_and_inf/1, nif_atom_too_long/1 ]). -export([many_args_100/100]). @@ -68,7 +70,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 +454,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 +1191,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]), @@ -1383,7 +1388,7 @@ is_checks(Config) when is_list(Config) -> self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try - ?line error = check_is_exception(), + ?line check_is_exception(), ?line throw(expected_badarg) catch error:badarg -> @@ -1595,19 +1600,94 @@ 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 + %% dirty 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 + end, + try + %% this checks that the expected exception occurs when the + %% dirty 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, + %% this checks that a dirty NIF can raise various terms as + %% exceptions + ok = nif_raise_exceptions(call_dirty_nif_exception) catch error:badarg -> {skipped,"No dirty scheduler support"} end. +nif_exception(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + %% this checks that the expected exception occurs when the NIF + %% calls enif_make_badarg at some point but then tries to return a + %% value that isn't an exception + call_nif_exception(0), + ?t:fail(expected_badarg) + catch + error:badarg -> + ok + end, + %% this checks that a NIF can raise various terms as exceptions + ok = nif_raise_exceptions(call_nif_exception), + ok. + +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 @@ -1687,7 +1767,20 @@ check(Exp,Got,Line) -> io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]), Got end. - + +nif_raise_exceptions(NifFunc) -> + ExcTerms = [{error, test}, "a string", <<"a binary">>, + 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]], + lists:foldl(fun(Term, ok) -> + try + erlang:apply(?MODULE,NifFunc,[Term]), + ?t:fail({expected,Term}) + catch + error:Term -> + [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + ok + end + end, ok, ExcTerms). %% The NIFs: lib_version() -> undefined. @@ -1741,8 +1834,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..1639e47d61 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) @@ -881,15 +883,19 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] * * This function is separate from check_is because it calls enif_make_badarg * and so it must return the badarg exception as its return value. Thus, the - * badarg exception indicates success. Failure is indicated by returning an - * error atom. + * badarg exception indicates success. */ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM badarg, exc_term; ERL_NIF_TERM error_atom = enif_make_atom(env, "error"); - 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; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + assert(!enif_is_exception(env, error_atom)); + badarg = enif_make_badarg(env); + assert(enif_is_exception(env, badarg)); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(exc_term, badarg_atom)); return badarg; } @@ -1533,9 +1539,12 @@ static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM result; if (argc != 2) return enif_make_atom(env, "false"); - return enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); + result = enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); + assert(!enif_is_exception(env, result)); + return result; } #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT @@ -1608,16 +1617,31 @@ 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: { - ERL_NIF_TERM args[255]; - int i; - for (i = 0; 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: { + int arg; + if (enif_get_int(env, argv[0], &arg) && arg < 2) { + ERL_NIF_TERM args[255]; + int 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, args); + } else { + return enif_raise_exception(env, argv[0]); + } + } + 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"); + } } - case 1: - return enif_make_badarg(env); 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 +1661,100 @@ static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL } #endif +/* + * If argv[0] is the integer 0, 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. + * + * For any other value of argv[0], use it as an exception term and return + * the exception. + */ +static ERL_NIF_TERM call_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM exc_term; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + int arg; + + if (enif_get_int(env, argv[0], &arg) && arg == 0) { + /* ignore return value */ enif_make_badarg(env); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(badarg_atom, exc_term)); + return enif_make_atom(env, "ok"); + } else { + ERL_NIF_TERM exc_retval = enif_raise_exception(env, argv[0]); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(argv[0], exc_term)); + return exc_retval; + } +} + +#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, NULL)); + 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])); @@ -1713,12 +1831,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (argc != 1 && !enif_is_map(env, map)) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_HEAD)) + if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_FIRST)) 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); @@ -1727,12 +1846,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (cnt && next_ret) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_TAIL)) + if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_LAST)) 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 +1864,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 +1939,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", 1, 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/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 9083545060..e61c330861 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1407,6 +1407,12 @@ spawn_executable(Config) when is_list(Config) -> run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]), + + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2] = run_echo_args(SpaceDir,[default]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", @@ -1809,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; @@ -1881,12 +1887,12 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> receive {P, started, SIds} -> SIds end end, Procs), - StartedTime = timer:now_diff(now(), Start)/1000000, + StartedTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000, ?t:format("StartedTime = ~p~n", [StartedTime]), true = StartedTime < SleepSecs, erlang:system_flag(multi_scheduling, block), lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), - DoneTime = timer:now_diff(now(), Start)/1000000, + DoneTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000, ?t:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index bf31655066..105d39f126 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -379,16 +379,15 @@ eat_high(Low) -> process_flag(priority, high), receive after 1000 -> ok end, exit(Low, {you, are, dead}), - {_, Sec, _} = now(), - loop(Sec, Sec). + loop(erlang:monotonic_time() + erlang:convert_time_unit(5,seconds,native)). %% Busy loop for 5 seconds. -loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 -> - {_, NewSec, _} = now(), - loop(OrigSec, NewSec); -loop(_, _) -> - ok. +loop(StopTime) -> + case StopTime >= erlang:monotonic_time() of + true -> ok; + false -> loop(StopTime) + end. %% Tries to send two different exit messages to a process. @@ -2450,16 +2449,13 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3906471f87..c5af12c6d1 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1829,11 +1829,11 @@ do_it(Tracer, Low, Normal, High, Max) -> do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> OldPrio = process_flag(priority, max), go_work(Low, Normal, High, Max), - StartWait = now(), + StartWait = erlang:monotonic_time(milli_seconds), %% Give the emulator a chance to balance the load... wait_balance(5), - EndWait = now(), - BalanceWait = timer:now_diff(EndWait,StartWait) div 1000, + EndWait = erlang:monotonic_time(milli_seconds), + BalanceWait = EndWait-StartWait, erlang:display({balance_wait, BalanceWait}), Timeout = ?DEFAULT_TIMEOUT - ?t:minutes(4) - BalanceWait, Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of @@ -2027,17 +2027,14 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 736dfe5b56..dcb10c947e 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -515,12 +515,10 @@ repeat(Fun, N) when is_integer(N) -> repeat(Fun, N-1). start_node(Config) -> - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) - ++ "-" ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), + ++ "-" ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), Pa = filename:dirname(code:which(?MODULE)), ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]). diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 10b7e16a74..4c50b8ba8c 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -167,16 +167,13 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), Opts = [{args, "-pa "++Pa++" "++Args}], ?t:start_node(Name, slave, Opts). diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index f959714be7..e3ac2d5d83 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -264,6 +264,37 @@ memory_test(_Config) -> []), cmp_memory(MWs, "unlink procs"), + mem_workers_call(MWs, + fun () -> + lists:foreach( + fun (P) -> + Tmr = erlang:start_timer(1 bsl 34, + P, + hello), + Tmrs = case get('BIF_TMRS') of + undefined -> []; + Rs -> Rs + end, + true = is_reference(Tmr), + put('BIF_TMRS', [Tmr|Tmrs]) + end, Ps) + end, + []), + cmp_memory(MWs, "start BIF timer procs"), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (Tmr) -> + true = is_reference(Tmr), + true = is_integer(erlang:cancel_timer(Tmr)) + end, get('BIF_TMRS')), + put('BIF_TMRS', undefined), + garbage_collect() + end, + []), + erts_debug:set_internal_state(wait, deallocations), + cmp_memory(MWs, "cancel BIF timer procs"), + DMs = mem_workers_call(MWs, fun () -> lists:map(fun (P) -> @@ -533,16 +564,13 @@ get_ets_limit(Config, EtsMax) -> start_node(Config, Envs) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(seconds)) ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]). stop_node(Node) -> diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 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..d406456f98 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -26,11 +26,17 @@ cancel_timer_1/1, start_timer_big/1, send_after_big/1, start_timer_e/1, send_after_e/1, cancel_timer_e/1, - read_timer_trivial/1, read_timer/1, - cleanup/1, evil_timers/1, registered_process/1]). + read_timer_trivial/1, read_timer/1, read_timer_async/1, + cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1, + same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1, + same_time_yielding_with_cancel_other_accessor/1, auto_cancel_yielding/1]). -include_lib("test_server/include/test_server.hrl"). +-define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated +-define(TIMEOUT_YIELD_LIMIT, 100). +-define(AUTO_CANCEL_YIELD_LIMIT, 100). + init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:seconds(30)), case catch erts_debug:get_internal_state(available_internal_state) of @@ -45,6 +51,7 @@ end_per_testcase(_Case, Config) -> ok. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> @@ -56,8 +63,12 @@ all() -> [start_timer_1, send_after_1, send_after_2, cancel_timer_1, start_timer_e, send_after_e, cancel_timer_e, start_timer_big, send_after_big, - read_timer_trivial, read_timer, cleanup, evil_timers, - registered_process]. + read_timer_trivial, read_timer, read_timer_async, + cleanup, evil_timers, registered_process, + same_time_yielding, same_time_yielding_with_cancel, + same_time_yielding_with_cancel_other, + same_time_yielding_with_cancel_other_accessor, + auto_cancel_yielding]. groups() -> []. @@ -162,7 +173,7 @@ cancel_timer_1(Config) when is_list(Config) -> start_timer_e(doc) -> ["Error cases for start_timer/3"]; start_timer_e(Config) when is_list(Config) -> ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(4728472847827482, + ?line {'EXIT', _} = (catch erlang:start_timer(1 bsl 64, self(), hej)), ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), @@ -180,7 +191,7 @@ send_after_e(doc) -> ["Error cases for send_after/3"]; send_after_e(suite) -> []; send_after_e(Config) when is_list(Config) -> ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(4728472847827482, + ?line {'EXIT', _} = (catch erlang:send_after(1 bsl 64, self(), hej)), ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), @@ -213,20 +224,58 @@ read_timer_trivial(Config) when is_list(Config) -> read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; read_timer(suite) -> []; read_timer(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:send_after(Big, self(), hej_hopp), + process_flag(scheduler, 1), + Big = 1 bsl 31, + R = erlang:send_after(Big, self(), hej_hopp), + + receive after 200 -> ok end, % Delay and clear reductions. + Left = erlang:read_timer(R), + Left2 = erlang:cancel_timer(R), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + false = erlang:read_timer(R), - ?line receive after 200 -> ok end, % Delay and clear reductions. - ?line Left = erlang:read_timer(R), - ?line Left = erlang:cancel_timer(R), - ?line false = erlang:read_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), + ok. - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, +read_timer_async(doc) -> ["Test that read_timer/1 seems to return the correct values."]; +read_timer_async(suite) -> []; +read_timer_async(Config) when is_list(Config) -> + process_flag(scheduler, 1), + Big = 1 bsl 33, + R = erlang:send_after(Big, self(), hej_hopp), + + %% Access from another scheduler + process_flag(scheduler, erlang:system_info(schedulers_online)), + + receive after 200 -> ok end, % Delay and clear reductions. + ok = erlang:read_timer(R, [{async, true}]), + ok = erlang:cancel_timer(R, [{async, true}, {info, true}]), + ok = erlang:read_timer(R, [{async, true}]), + + {read_timer, R, Left} = receive_one(), + {cancel_timer, R, Left2} = receive_one(), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + {read_timer, R, false} = receive_one(), + + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), ok. cleanup(doc) -> []; @@ -236,39 +285,42 @@ cleanup(Config) when is_list(Config) -> %% Timer on dead process ?line P1 = spawn(fun () -> ok end), ?line wait_until(fun () -> process_is_cleaned_up(P1) end), - ?line T1 = erlang:start_timer(10000, P1, "hej"), - ?line T2 = erlang:send_after(10000, P1, "hej"), + ?line T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"), + ?line T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"), + receive after 1000 -> ok end, ?line Mem = mem(), ?line false = erlang:read_timer(T1), ?line false = erlang:read_timer(T2), ?line Mem = mem(), %% Process dies before timeout - ?line P2 = spawn(fun () -> receive after 500 -> ok end end), - ?line T3 = erlang:start_timer(10000, P2, "hej"), - ?line T4 = erlang:send_after(10000, P2, "hej"), - ?line true = Mem < mem(), + ?line P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end), + ?line T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"), + ?line T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T3)), ?line true = is_integer(erlang:read_timer(T4)), ?line wait_until(fun () -> process_is_cleaned_up(P2) end), + receive after 1000 -> ok end, ?line false = erlang:read_timer(T3), ?line false = erlang:read_timer(T4), ?line Mem = mem(), %% Cancel timer - ?line P3 = spawn(fun () -> receive after 20000 -> ok end end), - ?line T5 = erlang:start_timer(10000, P3, "hej"), - ?line T6 = erlang:send_after(10000, P3, "hej"), - ?line true = Mem < mem(), + ?line P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end), + ?line T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"), + ?line T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:cancel_timer(T5)), ?line true = is_integer(erlang:cancel_timer(T6)), ?line false = erlang:read_timer(T5), ?line false = erlang:read_timer(T6), ?line exit(P3, kill), + ?line wait_until(fun () -> process_is_cleaned_up(P3) end), ?line Mem = mem(), %% Timeout ?line Ref = make_ref(), - ?line T7 = erlang:start_timer(500, self(), Ref), - ?line T8 = erlang:send_after(500, self(), Ref), - ?line true = Mem < mem(), + ?line T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref), + ?line T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T7)), ?line true = is_integer(erlang:read_timer(T8)), ?line receive {timeout, T7, Ref} -> ok end, @@ -420,10 +472,10 @@ registered_process(suite) -> []; registered_process(Config) when is_list(Config) -> ?line Mem = mem(), %% Cancel - ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), - ?line T2 = erlang:send_after(500, ?MODULE, "hej"), + ?line T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + ?line T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"), ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:cancel_timer(T1)), ?line true = is_integer(erlang:cancel_timer(T2)), ?line false = erlang:read_timer(T1), @@ -431,10 +483,10 @@ registered_process(Config) when is_list(Config) -> ?line Mem = mem(), %% Timeout register after start ?line Ref1 = make_ref(), - ?line T3 = erlang:start_timer(500, ?MODULE, Ref1), - ?line T4 = erlang:send_after(500, ?MODULE, Ref1), + ?line T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + ?line T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1), ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T3)), ?line true = is_integer(erlang:read_timer(T4)), ?line true = register(?MODULE, self()), @@ -443,9 +495,9 @@ registered_process(Config) when is_list(Config) -> ?line Mem = mem(), %% Timeout register before start ?line Ref2 = make_ref(), - ?line T5 = erlang:start_timer(500, ?MODULE, Ref2), - ?line T6 = erlang:send_after(500, ?MODULE, Ref2), - ?line true = Mem < mem(), + ?line T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + ?line T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + ?line true = mem_larger_than(Mem), ?line true = is_integer(erlang:read_timer(T5)), ?line true = is_integer(erlang:read_timer(T6)), ?line receive {timeout, T5, Ref2} -> ok end, @@ -454,10 +506,134 @@ registered_process(Config) when is_list(Config) -> ?line true = unregister(?MODULE), ?line ok. -mem() -> - AA = erlang:system_info(allocated_areas), - {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA), - Mem. +same_time_yielding(Config) when is_list(Config) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(milli_seconds) + 3000, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), hej, [{abs, true}]) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + lists:foreach(fun (Tmr) -> receive {timeout, Tmr, hej} -> ok end end, Tmrs), + Done = erlang:monotonic_time(milli_seconds), + true = Done >= Tmo, + case erlang:system_info(build_type) of + opt -> true = Done < Tmo + 200; + _ -> true = Done < Tmo + 1000 + end, + Mem = mem(), + ok. + +same_time_yielding_with_cancel(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(false, false). + +same_time_yielding_with_cancel_other(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(true, false). + +same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(true, true). + +do_cancel_tmrs(Tmo, Tmrs, Tester) -> + BeginCancel = erlang:convert_time_unit(Tmo, + milli_seconds, + micro_seconds) - 100, + busy_wait_until(fun () -> + erlang:monotonic_time(micro_seconds) >= BeginCancel + end), + lists:foreach(fun (Tmr) -> + erlang:cancel_timer(Tmr, + [{async, true}, + {info, true}]) + end, Tmrs), + case Tester == self() of + true -> ok; + false -> forward_msgs(Tester) + end. + +same_time_yielding_with_cancel_test(Other, Accessor) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(milli_seconds) + 3000, + Tester = self(), + Cancelor = case Other of + false -> + Tester; + true -> + spawn(fun () -> + receive + {timers, Tmrs} -> + do_cancel_tmrs(Tmo, Tmrs, Tester) + end + end) + end, + Opts = case Accessor of + false -> [{abs, true}]; + true -> [{accessor, Cancelor}, {abs, true}] + end, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), hej, Opts) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + case Other of + false -> + do_cancel_tmrs(Tmo, Tmrs, Tester); + true -> + Cancelor ! {timers, Tmrs} + end, + {Tmos, Cncls} = lists:foldl(fun (Tmr, {T, C}) -> + receive + {timeout, Tmr, hej} -> + receive + {cancel_timer, Tmr, Info} -> + false = Info, + {T+1, C} + end; + {cancel_timer, Tmr, false} -> + receive + {timeout, Tmr, hej} -> + {T+1, C} + end; + {cancel_timer, Tmr, TimeLeft} -> + true = is_integer(TimeLeft), + {T, C+1} + end + end, + {0, 0}, + Tmrs), + io:format("Timeouts: ~p Cancels: ~p~n", [Tmos, Cncls]), + Mem = mem(), + case Other of + true -> exit(Cancelor, bang); + false -> ok + end, + {comment, + "Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: " + ++ integer_to_list(Cncls)}. + +auto_cancel_yielding(Config) when is_list(Config) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + P = spawn(fun () -> + lists:foreach( + fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln)+1), + erlang:start_timer((1 bsl 28)+I*10, self(), hej) + end, + lists:seq(1, + ((?AUTO_CANCEL_YIELD_LIMIT*3+1) + *SchdlrsOnln))), + receive after infinity -> ok end + end), + true = mem_larger_than(Mem), + exit(P, bang), + wait_until(fun () -> process_is_cleaned_up(P) end), + receive after 1000 -> ok end, + Mem = mem(), + ok. process_is_cleaned_up(P) when is_pid(P) -> undefined == erts_debug:get_internal_state({process_status, P}). @@ -468,6 +644,19 @@ wait_until(Pred) when is_function(Pred) -> _ -> receive after 50 -> ok end, wait_until(Pred) end. +busy_wait_until(Pred) when is_function(Pred) -> + case catch Pred() of + true -> ok; + _ -> busy_wait_until(Pred) + end. + +forward_msgs(To) -> + receive + Msg -> + To ! Msg + end, + forward_msgs(To). + get(Time, Msg) -> receive Msg -> @@ -486,9 +675,10 @@ get_msg() -> end. start_slave() -> - ?line {A, B, C} = now(), ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C), + ?line Name = atom_to_list(?MODULE) + ++ "-" ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive])), {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]), Node. @@ -549,5 +739,58 @@ type(X) when is_port(X) -> {port, node(X)}; type(X) when is_binary(X) -> binary; type(X) when is_atom(X) -> atom; type(_) -> unknown. - + +mem_larger_than(no_fix_alloc) -> + true; +mem_larger_than(Mem) -> + mem() > Mem. + +mem() -> + erts_debug:set_internal_state(wait, deallocations), + erts_debug:set_internal_state(wait, deallocations), + case mem_get() of + {-1, -1} -> no_fix_alloc; + {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U + end. + +mem_get() -> + % Bif timer memory + Ref = make_ref(), + erlang:system_info({memory_internal, Ref, [fix_alloc]}), + mem_recv(erlang:system_info(schedulers), Ref, {0, 0}). + +mem_recv(0, _Ref, AU) -> + AU; +mem_recv(N, Ref, AU) -> + receive + {Ref, _, IL} -> + mem_recv(N-1, Ref, mem_parse_ilists(IL, AU)) + end. + + +mem_parse_ilists([], AU) -> + AU; +mem_parse_ilists([I|Is], AU) -> + mem_parse_ilists(Is, mem_parse_ilist(I, AU)). + +mem_parse_ilist({fix_alloc, false}, _) -> + {-1, -1}; +mem_parse_ilist({fix_alloc, _, IDL}, {A, U}) -> + case lists:keyfind(fix_types, 1, IDL) of + {fix_types, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {ThisA + A, ThisU + U}; + {fix_types, Mask, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {(ThisA + A) band Mask , (ThisU + U) band Mask} + end. + +mem_get_btm_aus([], A, U) -> + {A, U}; +mem_get_btm_aus([{BtmType, BtmA, BtmU} | Types], + A, U) when BtmType == bif_timer; + BtmType == accessor_bif_timer -> + mem_get_btm_aus(Types, BtmA+A, BtmU+U); +mem_get_btm_aus([_|Types], A, U) -> + mem_get_btm_aus(Types, A, U). diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 2c78aa394f..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 @@ -260,7 +260,9 @@ bif_process() -> apply(erlang, Name, Args), bif_process(); {do_time_bif} -> - _ = time(), %Assignment tells compiler to keep call. + %% Match the return value to ensure that the time() call + %% is not optimized away. + {_,_,_} = time(), bif_process(); {do_statistics_bif} -> statistics(runtime), @@ -276,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/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 45987cc319..25a59e0b07 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -72,7 +72,7 @@ config(priv_dir,_) -> info/1, tracer/1, combo/1, nosilent/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(5)), + Dog=test_server:timetrap(test_server:minutes(5)), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -179,107 +179,112 @@ nosilent(Config) when is_list(Config) -> %%% basic_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?NM, - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line shutdown(), - ?line ?NM, + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?NM, + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% return_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [meta]), - ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), - ?line shutdown(), - ?line ?NM, + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), + ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,0] = lambda_slave(LocalTail), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,0] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[meta]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line ?NM, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), + LocalTail = fun() -> + local_tail(1) + end, + [1,0] = lambda_slave(LocalTail), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,0] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[meta]), + N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + %% ?NM, + %% Can't check for erlang:*/* stuff since common_test or test_server + %% will likely call list_to_binary in the logger. just drain any potential + %% message + ok = flush(), ok. - + +flush() -> + receive _ -> flush() after 0 -> ok end. + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% stack_grow_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,loop,4}, [{'_',[],[{return_trace}]}],[meta]), - ?line Num = 1 bsl 15, - ?line Surface = + Num = 1 bsl 15, + Surface = fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid-> if N == Num -> ?NM, @@ -288,7 +293,7 @@ stack_grow_test() -> This(This, receive_next(), N+1) end end, - ?line Dive = + Dive = fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N) when P == Pid-> if N == 0 -> @@ -297,272 +302,263 @@ stack_grow_test() -> This(This, receive_next(), N-1) end end, - ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line List = collect(test_server:seconds(5)), - ?line ok = Dive(Dive, receive_next(), Num), - ?line ?NM, + apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% List = collect(test_server:seconds(5)), + ok = Dive(Dive, receive_next(), Num), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line setup(), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line Self = self(), - ?line GoOn = make_ref(), - - ?line Pid = + setup(), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, {'_',[],[]}], + Self = self(), + GoOn = make_ref(), + Pid = spawn_link( fun () -> erlang:trace_pattern({?MODULE,exported_wrap,1}, - Prog, [{meta, Self}]), + Prog, [{meta, Self}]), Self ! {self(), GoOn} end), - ?line receive {Pid, GoOn} -> ok end, - ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), - ?line {match_spec, false} = + receive {Pid, GoOn} -> ok end, + {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), + {match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, match_spec), - ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, MMS} = + {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, MMS} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line case MMS of - Prog -> - ok; - Wrong -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MMS]), - ?line {meta_match_spec,MMS2} = + case MMS of + Prog -> + ok; + Wrong -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MMS]), + {meta_match_spec,MMS2} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line io:format("~p~n",[MMS2]), - ?line case MMS2 of - Prog -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong2}}) - end, - ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - ?line {value, {meta, Self}} = - lists:keysearch(meta, 1, L), - ?line {value, {meta_match_spec, MMS}} = - lists:keysearch(meta_match_spec, 1, L), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), - ?line {meta_match_spec, []} = + io:format("~p~n",[MMS2]), + case MMS2 of + Prog -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong2}}) + end, + {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + {value, {meta, Self}} = lists:keysearch(meta, 1, L), + {value, {meta_match_spec, MMS}} = lists:keysearch(meta_match_spec, 1, L), + + erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), + {meta_match_spec, []} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), - ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, false} = + + erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), + {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - - ?line shutdown(), - ?line ?NM, + {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tracer_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), - ?line Setter = - spawn_link( - fun () -> - erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer1}]), - erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer1}]), - Self ! {self(), done} - end), - ?line receive {Setter, done} -> ok end, - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), - ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), - ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), + Setter = spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer1}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer1}]), + Self ! {self(), done} + end), + receive {Setter, done} -> ok end, + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), + {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), + {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), %% Initiate a return_trace that will fail since the tracer just stopped - ?line Slave ! Ref, - ?line receive_no_next(100), + Slave ! Ref, + receive_no_next(100), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Initiate trace messages that will fail - ?line Ref2 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref2]), - ?line Slave ! Ref2, - ?line receive_no_next(100), - ?line {meta,[]} = + Ref2 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref2]), + Slave ! Ref2, + receive_no_next(100), + {meta,[]} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,[]} = + {meta,[]} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Change tracer - ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer2}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer2}]), - ?line Ref3 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref3]), - ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), - ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer2}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer2}]), + Ref3 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref3]), + {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), + {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), %% Change tracer between call trace and return trace - ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer3}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer3}]), - ?line Slave ! Ref3, + Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer3}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer3}]), + Slave ! Ref3, %% The return trace should still come from Tracer2 - ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), - ?line Ref4 = make_ref(), + {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), + Ref4 = make_ref(), %% Now should Tracer3 be used - ?line apply_slave_async(?MODULE, receiver, [Ref4]), - ?line Slave ! Ref4, - ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), - ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), - ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), + apply_slave_async(?MODULE, receiver, [Ref4]), + Slave ! Ref4, + {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), + {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer3} = - erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta,Tracer3} = erlang:trace_info({?MODULE,receiver,1}, meta), + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer3} = + {meta,Tracer3} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), - ?line 1 = erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace(Slave, true, - [{tracer,LocalTracer} | Flags]), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), + 1 = erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace(Slave, true, + [{tracer,LocalTracer} | Flags]), %% - ?line {all, TraceInfo1} = + {all, TraceInfo1} = erlang:trace_info({?MODULE,receiver,1}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo1), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo1), - ?line {traced,local} = + {traced,local} = erlang:trace_info({?MODULE,receiver,1}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo1), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo1), %% - ?line {all, TraceInfo2} = + {all, TraceInfo2} = erlang:trace_info({erlang,phash2,2}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo2), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo2), - ?line {traced,local} = + {traced,local} = erlang:trace_info({erlang,phash2,2}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo2), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo2), %% - ?line {flags,Flags1} = erlang:trace_info(Slave, flags), - ?line Flags = lists:sort(Flags1), - ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), + {flags,Flags1} = erlang:trace_info(Slave, flags), + Flags = lists:sort(Flags1), + {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), %% - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line Slave ! Ref, - ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), - ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), - ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), - ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), - ?line case {receive_next_bytag(LocalTracer), + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + Slave ! Ref, + ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), + ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), + ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), + ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{erlang,phash2,2},0), ?RT(Slave,{?MODULE,receiver,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,receiver,1}), ?RF(Slave,{erlang,phash2,2},0)} -> - ?line ok; + ok; Error1 -> ?t:fail({unexpected_message, Error1}) end, - ?line case {receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{?MODULE,receiver,1},Ref), ?RT(Slave,{?MODULE,slave,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,slave,1}), ?RF(Slave,{?MODULE,receiver,1},Ref)} -> - ?line ok; + ok; Error2 -> ?t:fail({unexpected_message, Error2}) end, - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -570,38 +566,38 @@ combo_test() -> %% Setup silent local call tracing, and start it using meta trace. nosilent_test() -> - ?line Pid = setup(), - ?line Trigger = {?MODULE,id,1}, - ?line TriggerMS = [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true},{return_trace}]}], - ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line 1 = erlang:trace_pattern({?MODULE,local2,1}, - [{'_',[],[{return_trace}]}], - [local]), - ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line receive_no_next(17), - ?line start = apply_slave(?MODULE, id, [start]), - ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), - ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), - ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), - ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), - ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(), - ?line stop = apply_slave(?MODULE, id, [stop]), - ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), - ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), - ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), - ?line receive_no_next(17), - ?line shutdown(), + Pid = setup(), + Trigger = {?MODULE,id,1}, + TriggerMS = [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true},{return_trace}]}], + 1 = erlang:trace(Pid, true, [call,silent,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + 1 = erlang:trace_pattern({?MODULE,local2,1}, + [{'_',[],[{return_trace}]}], + [local]), + 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), + 1 = erlang:trace_pattern(Trigger,false,[local]), + 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + receive_no_next(17), + start = apply_slave(?MODULE, id, [start]), + ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), + [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), + ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), + ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), + ?RT(Pid,{?MODULE,local,1}) = receive_next(), + ?RT(Pid,{?MODULE,exported,1}) = receive_next(), + ?RT(Pid,{?MODULE,slave,1}) = receive_next(), + stop = apply_slave(?MODULE, id, [stop]), + ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), + ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), + [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), + receive_no_next(17), + shutdown(), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -645,9 +641,9 @@ slave(Sync) -> Sync ! sync, receive {From,apply, M, F, A} -> - ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - ?line Res = apply(M,F,A), - ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + Res = apply(M,F,A), + ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), From ! {apply, Res}, erlang:trace_pattern({?MODULE,slave,1},false,[meta]), slave(From); 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 b3507bdba7..16cecf2dba 100644 --- a/erts/emulator/valgrind/suppress.patched.3.6.0 +++ b/erts/emulator/valgrind/suppress.patched.3.6.0 @@ -273,6 +273,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { erts_bits_init_state; Why is this needed? @@ -357,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 a4da31a61d..a1f3f82364 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -260,6 +260,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { Prebuilt constant terms in os_info_init (PossiblyLost) @@ -325,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/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 9699491526..447aae47aa 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -345,7 +345,7 @@ static void run_daemon(EpmdVars *g) inform it of that the log is closed. */ closelog(); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("/dev/null", O_RDONLY); /* Order is important! */ open("/dev/null", O_WRONLY); @@ -386,7 +386,7 @@ static void run_daemon(EpmdVars *g) close(1); close(2); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("nul", O_RDONLY); open("nul", O_WRONLY); 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 b68e109b43..d6544a2829 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -808,6 +808,7 @@ int main(int argc, char **argv) case 'a': case 'A': case 'b': + case 'C': case 'e': case 'i': case 'n': @@ -881,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++) @@ -1150,15 +1164,15 @@ 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] " "[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] " "[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] " "[+T LEVEL] [+V] [+v] " - "[+W<i|w>] [+z MISC_OPTION] [args ...]\n"); + "[+W<i|w|e>] [+z MISC_OPTION] [args ...]\n"); exit(1); } 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/ose/run_erl.c b/erts/etc/ose/run_erl.c index 8bc49a485e..a6499f2bf3 100644 --- a/erts/etc/ose/run_erl.c +++ b/erts/etc/ose/run_erl.c @@ -615,7 +615,7 @@ int run_erl(int argc,char **argv) { returns */ PROCESS main_pid; hunt_in_block("run_erl","main",&main_pid); - sig = alloc(sizeof(sig),ERTS_SIGNAL_RUN_ERL_DAEMON); + sig = alloc(sizeof(*sig),ERTS_SIGNAL_RUN_ERL_DAEMON); send(&sig,main_pid); sig = receive(sigsel); pid = sender(&sig); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 78fefbea55..59cf29d381 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -43,6 +43,7 @@ # -gcov Run emulator compiled for gcov # -valgrind Run emulator compiled for valgrind # -lcnt Run emulator compiled for lock counting +# -icount Run emulator compiled for instruction counting # -nox Unset the DISPLAY variable to disable us of X Windows # # FIXME For GDB you can also set the break point using "-break FUNCTION". @@ -180,6 +181,11 @@ while [ $# -gt 0 ]; do cargs="$cargs -frmptr" TYPE=.frmptr ;; + "-icount") + shift + cargs="$cargs -icount" + TYPE=.icount + ;; "-dump") shift GDB=dump @@ -375,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 141d51824f..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 @@ -1065,8 +1116,8 @@ define etp-cp-1 set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 end if $etp_cp_p - # 12 = MI_FUNCTIONS - set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12) + # 13 = MI_FUNCTIONS + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 13) # 0 = MI_NUM_FUNCTIONS set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] set $etp_cp_p = 0 @@ -3514,11 +3565,13 @@ end define etp-carrier-blocks set $etp_crr = (Carrier_t*) $arg0 set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7) + set $etp_crr_end = ((char*)$etp_crr + ($etp_crr->chdr & ~7) - (sizeof(void*) & ~8)) set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size) set $etp_prev_blk = 0 set $etp_error_cnt = 0 set $etp_ablk_cnt = 0 set $etp_fblk_cnt = 0 + set $etp_aborted = 0 if $argc == 2 set $etp_be_silent = $arg1 @@ -3565,14 +3618,21 @@ define etp-carrier-blocks end set $etp_prev_blk = $etp_blk set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz) + if $etp_blk < (Block_t*) ((char*)$etp_prev_blk + $etp_alc->min_block_size) || $etp_blk >= $etp_crr_end + printf "ERROR: Invalid size of block at %#lx. ABORTING\n", $etp_prev_blk + set $etp_aborted = 1 + loop_break + end end - if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7)) - printf "ERROR: Last block not at end of carrier\n" - set $etp_error_cnt = $etp_error_cnt + 1 + if !$etp_aborted + if ((char*)$etp_blk + $etp_blk_sz) != $etp_crr_end + printf "ERROR: Last block not at end of carrier\n" + set $etp_error_cnt = $etp_error_cnt + 1 + end + printf "Allocated blocks: %u\n", $etp_ablk_cnt + printf "Free blocks: %u\n", $etp_fblk_cnt end - printf "Allocated blocks: %u\n", $etp_ablk_cnt - printf "Free blocks: %u\n", $etp_fblk_cnt if $etp_error_cnt printf "%u ERRORs reported above\n", $etp-error-cnt end 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 ad5d05704c..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 @@ -214,8 +214,6 @@ typedef OSPPDKEY ethr_tsd_key; /* Out own RW mutexes are probably faster, but use OSEs mutexes */ #define ETHR_USE_OWN_RWMTX_IMPL__ -#define ETHR_HAVE_THREAD_NAMES - #else /* No supported thread lib found */ #ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL @@ -364,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 @@ -501,21 +502,18 @@ typedef struct { typedef struct { int detached; /* boolean (default false) */ int suggested_stack_size; /* kilo words (default sys dependent) */ + char *name; /* max 14 char long (default no-name) */ #ifdef ETHR_OSE_THREADS - char *name; U32 coreNo; #endif } ethr_thr_opts; #if defined(ETHR_OSE_THREADS) -/* Default ethr name is big as we want to be able to sprint stuff in there */ -#define ETHR_THR_OPTS_DEFAULT_INITER \ - {0, -1, "ethread", 0} +#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL, 0} #else -#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1} +#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL} #endif - #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_AUX_IMPL__) # define ETHR_NEED_SPINLOCK_PROTOTYPES__ # define ETHR_NEED_RWSPINLOCK_PROTOTYPES__ @@ -529,6 +527,8 @@ int ethr_thr_join(ethr_tid, void **); int ethr_thr_detach(ethr_tid); void ethr_thr_exit(void *); ethr_tid ethr_self(void); +int ethr_getname(ethr_tid, char *, size_t); +void ethr_setname(char *); int ethr_equal_tids(ethr_tid, ethr_tid); int ethr_tsd_key_create(ethr_tsd_key *,char *); @@ -540,6 +540,7 @@ void *ethr_tsd_get(ethr_tsd_key); #include <signal.h> int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset); int ethr_sigwait(const sigset_t *set, int *sig); +int ethr_kill(const ethr_tid tid, const int sig); #endif void ethr_compiler_barrier(void); 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/Makefile.in b/erts/lib_src/Makefile.in index b680c03b1d..d0ebab49d8 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -92,6 +92,11 @@ CFLAGS += -DERTS_FRMPTR OMIT_OMIT_FP=yes PRE_LD= else +ifeq ($(TYPE),icount) +TYPE_SUFFIX = .icount +CFLAGS += -DERTS_OPCODE_COUNTER_SUPPORT +PRE_LD= +else override TYPE=opt OMIT_FP=true TYPE_SUFFIX= @@ -105,6 +110,7 @@ endif endif endif endif +endif OPSYS=@OPSYS@ sol2CFLAGS= diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c index 2c177ee5ac..a38017b62f 100644 --- a/erts/lib_src/common/erl_printf.c +++ b/erts/lib_src/common/erl_printf.c @@ -87,6 +87,41 @@ void (*erts_printf_unblock_fpe)(int) = NULL; # define FWRITE fwrite #endif +/* We use write for stdout and stderr as they could be + set to non-blocking by shell drivers, and non-blocking + FILE * functions work unpredictably as best */ +static int +printf_putc(int c, FILE *stream) { + if ((FILE*)stream == stdout || (FILE*)stream == stderr) { + int fd = stream == stdout ? fileno(stdout) : fileno(stderr); + /* cast to a char here, because write expects bytes. */ + unsigned char buf[1] = { c }; + int res; + do { + res = write(fd, buf, 1); + } while (res == -1 && (errno == EAGAIN || errno == EINTR)); + if (res == -1) return EOF; + return res; + } + + return PUTC(c, stream); +} + +static size_t +printf_fwrite(const void *ptr, size_t size, size_t nitems, + FILE *stream) { + if ((FILE*)stream == stdout || (FILE*)stream == stderr) { + int fd = stream == stdout ? fileno(stdout) : fileno(stderr); + int res; + do { + res = write(fd, ptr, size*nitems); + } while (res == -1 && (errno == EAGAIN || errno == EINTR)); + if (res == -1) return 0; + return res; + } + return FWRITE(ptr, size, nitems, stream); +} + static int get_error_result(void) { @@ -103,10 +138,10 @@ write_f_add_cr(void *vfp, char* buf, size_t len) size_t i; ASSERT(vfp); for (i = 0; i < len; i++) { - if (buf[i] == '\n' && PUTC('\r', (FILE *) vfp) == EOF) - return get_error_result(); - if (PUTC(buf[i], (FILE *) vfp) == EOF) - return get_error_result(); + if (buf[i] == '\n' && printf_putc('\r', (FILE *) vfp) == EOF) + return get_error_result(); + if (printf_putc(buf[i], (FILE *) vfp) == EOF) + return get_error_result(); } return len; } @@ -119,12 +154,12 @@ write_f(void *vfp, char* buf, size_t len) if (len <= 64) { /* Try to optimize writes of small bufs. */ int i; for (i = 0; i < len; i++) - if (PUTC(buf[i], (FILE *) vfp) == EOF) + if (printf_putc(buf[i], (FILE *) vfp) == EOF) return get_error_result(); } else #endif - if (FWRITE((void *) buf, sizeof(char), len, (FILE *) vfp) != len) + if (printf_fwrite((void *) buf, sizeof(char), len, (FILE *) vfp) != len) return get_error_result(); return len; } 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 79784c5b84..c0b1dad0b6 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -42,6 +42,7 @@ #include <sys/types.h> #include <unistd.h> #include <signal.h> +#include <string.h> #include <limits.h> @@ -49,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 @@ -77,6 +80,8 @@ typedef struct { void *(*thr_func)(void *); void *arg; void *prep_func_res; + char *name; + char name_buff[16]; } ethr_thr_wrap_data__; static void *thr_wrapper(void *vtwd) @@ -98,6 +103,8 @@ static void *thr_wrapper(void *vtwd) tsep = twd->tse; /* We aren't allowed to follow twd after result has been set! */ + if (twd->name) + ethr_setname(twd->name); ethr_atomic32_set(&twd->result, result); @@ -232,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 @@ -254,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; @@ -315,6 +330,12 @@ ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, twd.thr_func = func; twd.arg = arg; + if (opts && opts->name) { + snprintf(twd.name_buff, 16, "%s", opts->name); + twd.name = twd.name_buff; + } else + twd.name = NULL; + res = pthread_attr_init(&attr); if (res != 0) return res; @@ -445,6 +466,30 @@ ethr_self(void) } int +ethr_getname(ethr_tid tid, char *buf, size_t len) +{ +#if defined(ETHR_HAVE_PTHREAD_GETNAME_NP_3) + return pthread_getname_np((pthread_t) tid, buf, len); +#elif defined(ETHR_HAVE_PTHREAD_GETNAME_NP_2) + return pthread_getname_np((pthread_t) tid, buf); +#else + return ENOSYS; +#endif +} + +void +ethr_setname(char *name) +{ +#if defined(ETHR_HAVE_PTHREAD_SETNAME_NP_2) + pthread_setname_np(ethr_self(), name); +#elif defined(ETHR_HAVE_PTHREAD_SET_NAME_NP_2) + pthread_set_name_np(ethr_self(), name); +#elif defined(ETHR_HAVE_PTHREAD_SETNAME_NP_1) + pthread_setname_np(name); +#endif +} + +int ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) { return pthread_equal((pthread_t) tid1, (pthread_t) tid2); @@ -565,8 +610,157 @@ int ethr_sigwait(const sigset_t *set, int *sig) return 0; } +int ethr_kill(const ethr_tid tid, const int sig) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } +#endif + return pthread_kill((const pthread_t)tid, 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/lib_src/win/ethread.c b/erts/lib_src/win/ethread.c index 14d0b6deff..fe5d4a327f 100644 --- a/erts/lib_src/win/ethread.c +++ b/erts/lib_src/win/ethread.c @@ -508,6 +508,19 @@ ethr_self(void) return *tid; } +/* getname and setname are not available on windows */ +int +ethr_getname(ethr_tid tid, char *buf, size_t len) +{ + return ENOSYS; +} + +void +ethr_setname(char *name) +{ + return; +} + int ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) { diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 10138cab22..df12c6f8e0 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 7a3d94dd16..c0fca6aafa 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 9b364d8b21..0e0811af3f 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex a190129b2c..851513b2e9 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 621f036f33..33c112f4de 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 6695f4cd15..ebca6e7eea 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 5e9230826d..e8817d183e 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 83230d42ae..6729f06b79 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex b3abba3223..969239be98 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 7006764d96..281f668f8c 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 611a568014..ea8a911a2c 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]). @@ -93,7 +101,7 @@ float_to_list/1, float_to_list/2]). -export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]). --export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). +-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). -export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]). -export([insert_element/3]). @@ -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]). @@ -410,12 +425,27 @@ call_on_load_function(_P1) -> erlang:nif_error(undefined). %% cancel_timer/1 --spec erlang:cancel_timer(TimerRef) -> Time | false when +-spec erlang:cancel_timer(TimerRef) -> Result when TimerRef :: reference(), - Time :: non_neg_integer(). + Time :: non_neg_integer(), + Result :: Time | false. + cancel_timer(_TimerRef) -> erlang:nif_error(undefined). +%% cancel_timer/2 +-spec erlang:cancel_timer(TimerRef, Options) -> Result | ok when + TimerRef :: reference(), + Async :: boolean(), + Info :: boolean(), + Option :: {async, Async} | {info, Info}, + Options :: [Option], + Time :: non_neg_integer(), + Result :: Time | false. + +cancel_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). + %% check_old_code/1 -spec check_old_code(Module) -> boolean() when Module :: module(). @@ -931,6 +961,12 @@ get() -> get(_Key) -> erlang:nif_error(undefined). +%% get_keys/0 +-spec get_keys() -> [Key] when + Key :: term(). +get_keys() -> + erlang:nif_error(undefined). + %% get_keys/1 -spec get_keys(Val) -> [Key] when Val :: term(), @@ -1184,13 +1220,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). @@ -1292,6 +1333,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(), @@ -1357,11 +1482,26 @@ raise(_Class, _Reason, _Stacktrace) -> erlang:nif_error(undefined). %% read_timer/1 --spec erlang:read_timer(TimerRef) -> non_neg_integer() | false when - TimerRef :: reference(). +-spec erlang:read_timer(TimerRef) -> Result when + TimerRef :: reference(), + Time :: non_neg_integer(), + Result :: Time | false. + read_timer(_TimerRef) -> erlang:nif_error(undefined). +%% read_timer/2 +-spec erlang:read_timer(TimerRef, Options) -> Result | ok when + TimerRef :: reference(), + Async :: boolean(), + Option :: {async, Async}, + Options :: [Option], + Time :: non_neg_integer(), + Result :: Time | false. + +read_timer(_TimerRef, _Options) -> + erlang:nif_error(undefined). + %% ref_to_list/1 -spec erlang:ref_to_list(Ref) -> string() when Ref :: reference(). @@ -1406,9 +1546,23 @@ 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], + Abs :: boolean(), + Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + TimerRef :: reference(). + +send_after(_Time, _Dest, _Msg, _Options) -> + erlang:nif_error(undefined). + %% seq_trace/2 -spec erlang:seq_trace(P1, P2) -> seq_trace_info_returns() | {term(), term(), term(), term(), term()} when P1 :: atom(), @@ -1480,9 +1634,23 @@ 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], + Abs :: boolean(), + Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + TimerRef :: reference(). + +start_timer(_Time, _Dest, _Msg, _Options) -> + erlang:nif_error(undefined). + %% suspend_process/2 -spec erlang:suspend_process(Suspendee, OptList) -> boolean() when Suspendee :: pid(), @@ -1651,7 +1819,7 @@ element(_N, _Tuple) -> %% Not documented -spec erlang:get_module_info(Module, Item) -> ModuleInfo when Module :: atom(), - Item :: module | imports | exports | functions | attributes | compile | native_addresses, + 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). @@ -2118,6 +2286,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; @@ -2254,6 +2424,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(); @@ -2271,10 +2443,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; @@ -3041,16 +3217,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, @@ -3434,7 +3600,11 @@ blocks_size([], Acc) -> get_fix_proc([{ProcType, A1, U1}| Rest], {A0, U0}) when ProcType == proc; ProcType == monitor_sh; ProcType == nlink_sh; - ProcType == msg_ref -> + ProcType == msg_ref; + ProcType == ll_ptimer; + ProcType == hl_ptimer; + ProcType == bif_timer; + ProcType == accessor_bif_timer -> get_fix_proc(Rest, {A0+A1, U0+U1}); get_fix_proc([_|Rest], Acc) -> get_fix_proc(Rest, Acc); diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index 345a6ae3be..cf9a06599a 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -35,7 +35,7 @@ {registered, []}, {applications, []}, {env, []}, - {runtime_dependencies, ["stdlib-2.0", "kernel-3.0", "sasl-2.4"]} + {runtime_dependencies, ["stdlib-2.5", "kernel-4.0", "sasl-2.4"]} ]}. %% vim: ft=erlang 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/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 79ff013c77..622e1be869 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -127,37 +127,18 @@ drv2protocol(_) -> undefined. %% TODO: shutdown equivalent for SCTP %% shutdown(S, read) when is_port(S) -> - shutdown_2(S, 0); + shutdown_1(S, 0); shutdown(S, write) when is_port(S) -> shutdown_1(S, 1); shutdown(S, read_write) when is_port(S) -> shutdown_1(S, 2). shutdown_1(S, How) -> - case subscribe(S, [subs_empty_out_q]) of - {ok,[{subs_empty_out_q,N}]} when N > 0 -> - shutdown_pend_loop(S, N); %% wait for pending output to be sent - _Other -> ok - end, - shutdown_2(S, How). - -shutdown_2(S, How) -> case ctl_cmd(S, ?TCP_REQ_SHUTDOWN, [How]) of {ok, []} -> ok; {error,_}=Error -> Error end. -shutdown_pend_loop(S, N0) -> - receive - {empty_out_q,S} -> ok - after ?INET_CLOSE_TIMEOUT -> - case getstat(S, [send_pend]) of - {ok,[{send_pend,N0}]} -> ok; - {ok,[{send_pend,N}]} -> shutdown_pend_loop(S, N); - _ -> ok - end - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% CLOSE(insock()) -> ok 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/erlc_SUITE_data/src/start_ok.script b/erts/test/erlc_SUITE_data/src/start_ok.script index 4cd89f0439..7ef97dc3f3 100644 --- a/erts/test/erlc_SUITE_data/src/start_ok.script +++ b/erts/test/erlc_SUITE_data/src/start_ok.script @@ -52,7 +52,6 @@ shell_default, timer, gen_fsm, - pg, unix, dict, pool, @@ -156,7 +155,6 @@ {timer,1}, {gen_fsm,1}, {io_lib_pretty,1}, - {pg,1}, {slave,1}, {unix,1}, {dict,1}, 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 2969383d66..c416e031c2 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -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]. @@ -287,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) -> diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index 217056971e..4858bfdfb7 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -238,7 +238,10 @@ do_upgrade(FromVsn,FromApps,ToRel,ToApps,InstallDir) -> [{"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), - {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRel]), + ToRelName = filename:basename(ToRel), + copy_file(ToRel++".tar.gz", + filename:join([InstallDir,releases,ToRelName++".tar.gz"])), + {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]), [{"OTP upgrade test",ToVsn,_,unpacked}, {"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), diff --git a/erts/vsn.mk b/erts/vsn.mk index abc9c0ba10..ab98bd4a17 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,7 +17,7 @@ # %CopyrightEnd% # -VSN = 6.4 +VSN = 7.0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |